home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 11 / FM Towns Free Software Collection 11.iso / t_os / tool / hk2 / bas / hk2cld.bas < prev    next >
Encoding:
BASIC Source File  |  1995-07-09  |  68.4 KB  |  1,799 lines
  1. 10 '------------------------------------------------------------------
  2. 20 '  HK2cld.BAS    Copyrigit(C) T.Komura
  3. 30 '
  4. 31 '  Version 1.0  1991.07.17-1991.07.21
  5. 32 '          1.1  1991.08.04 文字入力ルーチン v1.1-->v1.3
  6. 33 '          1.2  1991.08.13 メモマーク表示追加
  7. 34 '          1.2a 1991.10.03 文字入力ルーチンを元に戻す
  8. 35 '          1.2b 1991.12.25 メモ追記後のマーク表示追加
  9. 36 '          1.3  1991.12.25 メモ･行事一覧表示追加
  10. 37 '          1.3a 1991.12.29 本日､前月､次月直接指定追加
  11. 40 '  hkcalend1.3  1994.02.01 家計簿プログラムにリンク
  12. 41 '  HK V2.0 L10a 1995.06.18 V2.0
  13. 100 '------------------------------------------------------------------
  14. 120 CLEAR ,,,,1024,300*1024
  15. 130 DIM CFI$(15)
  16. 140 GOSUB *CONFIGファイルチェック
  17. 165 '------------------------------------------------------------------
  18. 170 休日1$="(祝日)" ' 休日を検出する行事ファイル内のキーワード 1
  19. 171 休日2$="(休日)" '
  20. 180 代休1 =1        ' 休日が日曜日と重なった場合月曜日を代休とする時"1" 
  21. 181 代休2 =0        ' 会社等の休日
  22. 185 '--[使用環境設定領域 ここまで]-------------------------------------
  23. 190 '
  24. 200 *初期設定:'--------------------------------------------------------
  25. 210 CMD$="CD "+PRGDRV$:SHELL CMD$
  26. 220 CONSOLE 0,24,0:MOUSE 0
  27. 230 DIM MSGD%(28000):' 音声メッセージ配列定義 プログラム先頭で定義
  28. 240 LOAD@ FMBDRV$+"\FMP.FMB"
  29. 250 PLAY "@30T150V6":DATX$=DATE$
  30. 255 'ウインドウ関係座標配列
  31. 256 G=8:B=50
  32. 260 DIM B_X1(G,B),B_X2(G,B),B_Y1(G,B),B_Y2(G,B),BST(G,B)
  33. 265 DIM W_X1(G),W_X2(G),W_Y1(G),W_Y2(G)
  34. 266 DIM W_XA(G),W_XB(G),W_YA(G),W_YB(G)
  35. 267 DIM MD_SB#(10465),MD_SW#(10465),MAT#(5925):'max : HELP window
  36. 268 'デ－タ配列
  37. 270 DIM EVDT$(12,32),MEDT$(32,2)
  38. 295 DIM DOC$(2000)                            :'HELPデータ
  39. 300 INTERVAL 1                  :'プログラム先頭
  40. 310 ON INTERVAL GOSUB *時計表示 :'プログラム先頭 
  41. 320 GOSUB *ボタン座標読み取り
  42. 330 'CLS:COLOR 7:PRINT int((int(((408-36+1)+7)/8)*(213-30+1)*4+8-1)/8)
  43. 360 DIM LMB#(900),ABOUTD#(2071),HLPL#(397),HLPC#(8449),BIOD#(4324)
  44. 370 ON ERROR GOTO *ERROR
  45. 400 GOSUB *MCREAD:GOSUB *DCLOCKREAD
  46. 440 '
  47. 510 CTRLB1=17:'コントロールボタン個数
  48. 515 CTRLB2=15
  49. 524 HKCLD  =5  :'検索ボタン番号
  50. 526 HKCLDEND=10:'終了ボタン番号
  51. 540 DOCF$="\HK2cld.HLP"
  52. 600 CCHGINT=3  :'年月変更後2秒以上経過すると自動的にカレンダーを表示
  53. 980 '
  54. 1000 *メインルーチン:'･･･････････････････････････････････････････････････
  55. 1005 GOSUB *SEFFECT1
  56. 1015 MESN=1:GOSUB *MESDSP:PRINT VERN$;
  57. 1020 GOSUB *本日の日付
  58. 1040 GOSUB *本日のカレンダー表示
  59. 1045 MESN=28:GOSUB *SNDMSG
  60. 1050 MOUSE 1,320,64,1:MODE=11:MODEX=11
  61. 1060 MCN=1:GOSUB *MCDSET
  62. 1100 *メイン選択
  63. 1110 IF MES2OFF=0 THEN MESN=2:GOSUB *MESDSP
  64. 1120 SWPASS=1:G=1:GOSUB *MCSELECT
  65. 1122 IF CDSPQUE=1 THEN GOTO *S00
  66. 1130 IF SWNO<0 THEN GOTO *メイン選択'
  67. 1140 IF SWNO=0 THEN GOTO *SSEL
  68. 1150 '            HK2  記入 検索 分析 CLD  設定 日付 時計 HELP EXIT JUMP 年間 行事 日数 ﾊﾞｲｵ                           実行 取消 yup  ydn  y+10 y-10 mup  mdn  先月 次月 行事
  69. 1155 ON SWNO GOTO *S01,*S02,*S02,*S02,*S02,*S02,*S04,*S03,*S07,*S08,*S09,*S10,*S11,*S12,*S13,                          *S00,*S06,*S20,*S21,*S22,*S23,*S24,*S25,*S26,*S27,*S14
  70. 1160 '
  71. 1200 *S06:GOTO *メイン選択
  72. 1500 *S00:' 表示 --------------------------------------------------------
  73. 1502  IF CDSPQUE=1 THEN 1510
  74. 1504  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  75. 1510  CCHGF=0:CDSPQUE=0
  76. 1525  MESN=5:GOSUB *MESDSP
  77. 1530  GOSUB *指定カレンダー表示
  78. 1535 ' MESN=31:GOSUB *SNDMSG
  79. 1538  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  80. 1540  MES2OFF=0:GOTO *メイン選択
  81. 1900 '
  82. 2000 *S14:' 行事入力 ----------------------------------------------------
  83. 2010  IF CSRINIT=0 THEN *メイン選択
  84. 2020  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  85. 2025  MESN=7:GOSUB *MESDSP:MESN=20:GOSUB *SNDMSG
  86. 2030  GOSUB *行事入力
  87. 2070   EVDT$(MN,SELDY)=EVENT$
  88. 2080   GOSUB *EVPUT:MEMN=0:GOSUB *マーク追加表示
  89. 2150  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  90. 2200  GOTO *メイン選択
  91. 2210 '
  92. 3300 *S09:'cldJUMP
  93. 3305  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  94. 3310  IF CCHGF=1 OR SELCF=0 THEN GOTO 3470
  95. 3320  DY$=RIGHT$(STR$(SELDY+100),2)
  96. 3330  DT$=YR$+"."+MN$+"."+DY$
  97. 3350  CMES$="指定日付の｢記入･編集モード｣へ移行":GOSUB *確認
  98. 3360  ON CAUNO GOTO 3400,3470
  99. 3400  GOSUB *DTSAVE
  100. 3410  SWNO=2:GOTO *S02
  101. 3470  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  102. 3480  MES2OFF=0:GOTO *メイン選択
  103. 3490 '
  104. 3500 *S20:' 1年先 -------------------------------------------------------
  105. 3510  YDEF= +1:MDEF= 0:GOTO *SYRRNEW
  106. 3520 *S21:' 1年前 -------------------------------------------------------
  107. 3530  YDEF= -1:MDEF= 0:GOTO *SYRRNEW
  108. 3540 *S22:'10年先 -------------------------------------------------------
  109. 3550  YDEF=+10:MDEF= 0:GOTO *SYRRNEW
  110. 3560 *S23:'10年前 -------------------------------------------------------
  111. 3570  YDEF=-10:MDEF= 0:GOTO *SYRRNEW
  112. 3580 *S24:' 1月先 -------------------------------------------------------
  113. 3585  YDEF=  0:MDEF=+1:GOTO *SYRRNEW
  114. 3590 *S25:' 1月前 -------------------------------------------------------
  115. 3595  YDEF=  0:MDEF=-1:GOTO *SYRRNEW
  116. 3600 *SYRRNEW
  117. 3605  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  118. 3610  CCHGT=TIME:CCHGF=1
  119. 3620  IF CDSPF=0 THEN 3660
  120. 3630  GOSUB *カレンダー消去:SELCF=0
  121. 3660  GOSUB *年月日変更
  122. 3670  IF SWNO<22 THEN GOSUB *メイン年表示 ELSE GOSUB *メイン年月表示
  123. 3680  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  124. 3685  MESN=6:GOSUB *MESDSP:MES2OFF=1
  125. 3690  GOTO *メイン選択
  126. 3695 '
  127. 3700 *SSEL:'------------------------------------------------------------
  128. 3705  GOSUB *カレンダー選択判定
  129. 3710  IF TBMSEL=0 THEN 3790
  130. 3715  IF CDSPF =0 THEN 3790
  131. 3720  SELDY=CLM(TBX,TBY)
  132. 3730  GOSUB *日カーソル表示:SELCF=1
  133. 3740  GOSUB *行事表示
  134. 3750  'GOSUB *MECHK                    :'////////// 1991.08.13
  135. 3755  'IF MECHK=1 THEN GOSUB *MEGET    :'////////// 1991.08.13
  136. 3790  GOTO *メイン選択
  137. 3830 '
  138. 4500 *S10:'年間カレンダーへ切替え----------------------------------------
  139. 4520  IF CCHGF=1 THEN GOTO 4655
  140. 4530  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  141. 4532  SWNOX=SWNO:G=2:GMCD=1:GOSUB *ガイド表示
  142. 4535  MESN=9:GOSUB *MESDSP:MESN=15:GOSUB *SNDMSG
  143. 4540  GOSUB *年間カレンダー用紙
  144. 4550  GOSUB *年間カレンダー表示
  145. 4555  MESN=3:GOSUB *MESDSP:MESN=14:GOSUB *SNDMSG
  146. 4560  SWPASS=0:GOSUB *MCSELECT
  147. 4565  IF SWNO<0 THEN SWNO=1
  148. 4566  IF SWNO=2 THEN GOSUB *MCDRAG:GOTO 4560
  149. 4570  IF SWNO<>0 THEN GOTO 4580
  150. 4572  MCN=3:GOSUB *MCDSET:MESN=13:GOSUB *SNDMSG
  151. 4575  MCN=1:GOSUB *MCDSET:GOTO 4560
  152. 4580  G=2:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  153. 4600  GOSUB *用紙消去
  154. 4620  SWNO=SWNOX:GMCD=0:GOSUB *ガイド表示
  155. 4630  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  156. 4655  MES2OFF=0:GOTO *メイン選択
  157. 4660 '
  158. 5000 *S12:'日数計算へ切替え----------------------------------------
  159. 5005  IF CCHGF=1 THEN GOTO 5150
  160. 5010  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  161. 5020  SWNOX=SWNO:G=7:GMCD=3:GOSUB *ガイド表示
  162. 5035  MESN=12:GOSUB *MESDSP
  163. 5040  GOSUB *日数計算用紙
  164. 5045  MESN=20:GOSUB *SNDMSG
  165. 5050  GOSUB *日数計算メイン
  166. 5100  GOSUB *用紙消去
  167. 5120  SWNO=SWNOX:GMCD=0:GOSUB *ガイド表示
  168. 5130  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  169. 5150  MES2OFF=0:GOTO *メイン選択
  170. 5160 '
  171. 5500 *S13:'バイオリズムへ切替え----------------------------------------
  172. 5505  IF CCHGF=1 THEN GOTO 5650
  173. 5530  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  174. 5532  SWNOX=SWNO:G=8:GMCD=4:GOSUB *ガイド表示
  175. 5540  GOSUB *バイオリズム用紙
  176. 5545  MESN=10:GOSUB *MESDSP:MESN=20:GOSUB *SNDMSG
  177. 5550  GOSUB *バイオリズムメイン
  178. 5600  GOSUB *用紙消去
  179. 5610  SWNO=SWNOX:GMCD=0:GOSUB *ガイド表示
  180. 5620  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  181. 5650  MES2OFF=0:GOTO *メイン選択
  182. 5660 '
  183. 5700 *S11:'行事一覧表示 -----------------------------------------------
  184. 5705  IF CCHGF=1 THEN GOTO 5780
  185. 5720  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  186. 5726  SWNOX=SWNO:G=4:GMCD=2:GOSUB *ガイド表示
  187. 5730  GOSUB *メモ一覧用紙
  188. 5740  GOSUB *行事一覧表示メイン
  189. 5750  GOSUB *用紙消去
  190. 5755  SWNO=SWNOX:GMCD=0:GOSUB *ガイド表示
  191. 5760  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  192. 5780  MES2OFF=0:GOTO *メイン選択
  193. 5790 '
  194. 5990 '
  195. 6000 *S01:'About HK2---------------------------------------------------'
  196. 6010  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  197. 6020  MESN=1:GOSUB *MESDSP
  198. 6030  GOSUB *ABOUT表示
  199. 6060  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  200. 6070  GOTO *メイン選択
  201. 6080 '
  202. 6100 *S03:'Digital Clock ----------------------------------------------'
  203. 6110  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  204. 6120  MESN=1:GOSUB *MESDSP
  205. 6130  GOSUB *DGCLOCK
  206. 6160  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  207. 6170  GOTO *メイン選択
  208. 6180 '
  209. 6200 *S07:'Help -------------------------------------------------------'
  210. 6210  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  211. 6220  MESN=14:GOSUB *MESDSP
  212. 6230  GOSUB *HKHELP
  213. 6260  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  214. 6270  GOTO *メイン選択
  215. 6280 '
  216. 6900 '
  217. 7000 *S04:'本日のカレンダー表示[直接指定] -----------------------------
  218. 7010  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  219. 7020  IF YR=TY AND MN=TM THEN 7040
  220. 7026  GOSUB *カレンダー消去
  221. 7030  MESN=5:GOSUB *MESDSP:MESN=24:GOSUB *SNDMSG
  222. 7035  GOSUB *本日のカレンダー表示
  223. 7040  YR=TY:MN=TM:GOSUB *WEEKN:SELDY=TD
  224. 7050    TBX=(WK+TD-1) MOD 7
  225. 7055    TBY=INT((WK+TD-1)/7)
  226. 7060  GOSUB *日カーソル表示:SELCF=1
  227. 7070  GOSUB *行事表示
  228. 7085  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  229. 7086  MESN=28:GOSUB *SNDMSG
  230. 7090  GOTO *メイン選択
  231. 7095 '
  232. 7200 *S26:'前月のカレンダー表示[直接指定] -----------------------------
  233. 7210  YDEF=  0:MDEF=-1:GOTO *SYRRNEW2
  234. 7220 *S27:'次月のカレンダー表示[直接指定] -----------------------------
  235. 7230  YDEF=  0:MDEF=+1:GOTO *SYRRNEW2
  236. 7250 *SYRRNEW2
  237. 7260  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  238. 7270  G=1:B=1   :BST(1,1)=0:GOSUB *BTN_ONOFF
  239. 7280  GOSUB *カレンダー消去:SELCF=0
  240. 7290  GOSUB *年月日変更
  241. 7295  GOSUB *メイン年月表示
  242. 7300  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  243. 7310  CDSPQUE=1:GOTO *S00
  244. 7900 '
  245. 8000 *S02:'プログラム呼び出し･･････････････････････････････････････････
  246. 8010 IF SWNO=HKCLD THEN GOTO *メイン選択
  247. 8020 G=1:B=HKCLD:BST(G,B)=0:GOSUB *BTN_ONOFF
  248. 8025 G=1:B=SWNO :BST(G,B)=1:GOSUB *BTN_ONOFF
  249. 8110 MESN=13:GOSUB *MESDSP':MESN=24:GOSUB *SNDMSG
  250. 8120 INTERVAL OFF:GOSUB *SEFFECT2
  251. 8130 ON SWNO-1 GOTO *S021,*S022,*S023,*S02,*S025
  252. 8150 '
  253. 8160 *S021:RUN "HK2in.bas"
  254. 8170 *S022:RUN "HK2src.bas"
  255. 8180 *S023:RUN "HK2anl.bas"
  256. 8190 *S025:RUN "HK2cfg.bas"
  257. 8940 '
  258. 9000 *S08:'終了････････････････････････････････････････････････････････
  259. 9020 G=1:B=HKCLDEND:BST(G,B)=1:GOSUB *BTN_ONOFF
  260. 9060 '
  261. 9110 MESN=13:GOSUB *MESDSP:MESN=24:GOSUB *SNDMSG
  262. 9120 INTERVAL OFF
  263. 9130 GOSUB *SEFFECT2
  264. 9150 RUN "hk2.bas"
  265. 9160 '
  266. 9900 '-------------------------------------------------------------------
  267. 9910 '    ＧＥＮＥＲＡＬ　ＳＵＢ　ＲＯＵＴＩＮＥ
  268. 9920 '-------------------------------------------------------------------
  269. 10000 *CHR1IN:'////////// 1文字入力
  270. 10010  A$=INKEY$:IF A$="" THEN 10010
  271. 10020  A=INSTR(C$,A$)
  272. 10030  IF A=0 THEN MESN=13:GOSUB *SNDMSG:GOTO 10010
  273. 10040  RETURN
  274. 10050 '
  275. 10060 '
  276. 10070 *MESDSP:'////////// メッセージ表示
  277. 10080  RESTORE *MESDAT
  278. 10090  FOR IM=1 TO MESN:READ XM,YM,CM,CB,BM,MES$:NEXT IM
  279. 10105  LINE(0,463)-(639,479),PSET,0,BF
  280. 10115  SYMBOL(0,465),MES$,.75!,.75!,CM
  281. 10120  'IF BM=1 THEN PLAY "L4O4A"
  282. 10130  RETURN
  283. 10140 '
  284. 10200 *MESDAT:'////////// メッセージデータ
  285. 10205 '    XM, YN, CM, CB, BM
  286. 10210 DATA  2, 23,  5,  0,  1 :'--- 01
  287. 10215 DATA "家計簿システム ＨＫ２ ｢カレンダー｣モード"
  288. 10220 DATA  2, 23,  7,  0,  0 :'--- 02
  289. 10225 DATA "マウスで適当にボタンを選んで押してくださいね｡"
  290. 10230 DATA  2, 23,  7,  0,  0 :'--- 03
  291. 10235 DATA "[■] を押してください｡ メインカレンダーにもどります｡"
  292. 10240 DATA  2, 23,  7,  0,  1 :'--- 04
  293. 10245 DATA "CDパネルのボタンを押してね！ 終わったら[ﾛ]ボタンを押してください｡"
  294. 10250 DATA  2, 23,  4,  0,  1 :'--- 05
  295. 10255 DATA "★ご指定のカレンダーを一生懸命つくっています｡"
  296. 10260 DATA  2, 23,  6,  0,  1 :'--- 06
  297. 10265 DATA "[表示]ボタンを押すと､すぐにカレンダーが表示されます｡"
  298. 10270 DATA  2, 23,  5,  0,  1 :'--- 07
  299. 10275 DATA "                                                                  ｢行事｣を入力してください｡ "
  300. 10280 DATA  2, 23,  7,  0,  0 :'--- 08
  301. 10285 DATA "｢メモ｣を入力してください｡ "
  302. 10290 DATA  2, 23,  4,  0,  1 :'--- 09
  303. 10295 DATA "★｢年間カレンダー｣を必死に作っています｡ちょっと待ってね！"
  304. 10300 DATA  2, 23,  7,  0,  0 :'--- 10
  305. 10305 DATA "あなたの誕生日を入力して[実行]を押してください｡  終了は[取消]"
  306. 10310 DATA  2, 23,  4,  0,  0 :'--- 11
  307. 10315 DATA "★｢バイオリズム｣グラフをのんびりと作っています｡"
  308. 10320 DATA  2, 23,  7,  0,  0 :'--- 12
  309. 10325 DATA "日数計算の開始日､終了日を入力し､[実行]ボタンを押してください｡   終了は[取消]"
  310. 10330 DATA  2, 23,  5,  0,  1 :'--- 13
  311. 10335 DATA "★★★しばらくお待ちください....."
  312. 10340 DATA  2, 23,  5,  0,  1 :'--- 14
  313. 10345 DATA "HKHELP★カレンダーモードの説明を表示しています｡  頁移動-[ﾋ][ﾌ] 行移動-[▲][▼] 終了-[■]" 
  314. 10350 DATA  2, 23,  4,  0,  1 :'--- 15
  315. 10355 DATA ""
  316. 10360 DATA  2, 23,  7,  0,  1 :'--- 16
  317. 10365 DATA "上旬､中旬､下旬を選択してください｡ 終了は[■]を押してください｡"
  318. 10370 DATA  2, 23,  4,  0,  1 :'--- 17
  319. 10375 DATA ""
  320. 10380 DATA  2, 23,  6,  0,  1 :'--- 18
  321. 10385 DATA "メインカレンダーの[表示]ボタンを先に押してね！！"
  322. 10390 DATA  2, 23,  6,  0,  1 :'--- 19
  323. 10395 DATA "この月のメモデータのファイルはありませんよ！！"
  324. 10600 *SEFFECT1'////////////////////////////////////////////////////////
  325. 10605  SCREEN 1,1,2,1:PALETTE 9,[0,0,0]:LINE(0,0)-(639,479),PSET,1,BF
  326. 10610  SCREEN 1,0,2,1:GOSUB *表紙表示
  327. 10612  SCREEN 1,1,3,1:
  328. 10620  FOR II=0 TO 240 STEP 2:PALETTE 9,[II,II,II]
  329. 10621 '   LINE(320-II,240-II*3/4)-(320+II,240+II*3/4),PSET,0,B
  330. 10622     LINE(0,240-II)-(639,240+II),PSET,0,BF
  331. 10623  NEXT II
  332. 10630  SCREEN 1,0,1,0:INTERVAL ON
  333. 10640  SCREEN 0
  334. 10645  RETURN
  335. 10650 '
  336. 10700 *SEFFECT2'////////////////////////////////////////////////////////
  337. 10712  SCREEN 1,1,3,1:
  338. 10720  FOR II=240 TO 0 STEP -1:PALETTE 9,[II,II,II]
  339. 10721     LINE(0,240+II)-(639,240-II),PSET,1,B
  340. 10723  NEXT II
  341. 10730  MESN=13:GOSUB *MESDSP
  342. 10740  RETURN
  343. 10990 '
  344. 11000 *SNDMSG:'  SAVE "SNDMSG.SUB",A
  345. 11005  IF SNDMF=0 THEN RETURN
  346. 11010  '･････････････････  サウンドメッセージ実行サブルーチン  1989.02.04
  347. 11020  '                   入力=MESN (メッセージNo.)
  348. 11030  '
  349. 11070  IF MESN>36 THEN *RETURN_SNDMSG :'END
  350. 11080  RESTORE *MSGNAM
  351. 11090  FOR IMSG=1 TO MESN
  352. 11100    READ MSGD$
  353. 11110  NEXT IMSG
  354. 11120  MSGFN$=SNDDRV$+"\"+MSGD$+"_F.SND"
  355. 11130  LOAD@ MSGFN$,MSGD%
  356. 11140  PCMPLAY MSGD%:WAIT SWAIT\1+1
  357. 11150 *RETURN_SNDMSG :RETURN
  358. 11160 *MSGNAM :'////////// .SND File Name Data
  359. 11170 DATA "OHA1"   :'  1 おはよう
  360. 11180 DATA "KONN"   :'  2 こんにちわ
  361. 11190 DATA "KONBAN" :'  3 こんばんわ
  362. 11200 DATA "goyuku" :'  4 ごゆっくり
  363. 11210 DATA "GOKRO2" :'  5 ごくろうさま
  364. 11220 DATA "OTUKA"  :'  6 お疲れさま
  365. 11230 DATA "DOUZO"  :'  7 おまたせ
  366. 11240 DATA "ARIGA2" :'  8 ありがとう
  367. 11250 DATA "RUNRUN" :'  9 るんるん
  368. 11260 DATA "DAMEDE" :' 10 だめでしょう
  369. 11270 DATA "IIDE1"  :' 11 いいですか
  370. 11280 DATA "NANISI" :' 12 なにしてるの
  371. 11290 DATA "DAMEDA" :' 13 だめだめ
  372. 11300 DATA "OWARI"  :' 14 終わりました
  373. 11310 DATA "SIBA"   :' 15 しばらくお待ち下さい
  374. 11320 DATA "YOROSI" :' 16 よろしいですか
  375. 11330 DATA "TYANTO" :' 17 ちゃんとしなさい
  376. 11340 DATA "ERANDE" :' 18 選んでください
  377. 11350 DATA "KAKNIN" :' 19 確認して下さい
  378. 11360 DATA "NYURYO" :' 20 入力してください
  379. 11370 DATA "IRA"    :' 21 いらっしゃいませ 
  380. 11380 DATA "OYASUM" :' 22 おやすみ
  381. 11390 DATA "ARIGA3" :' 23 ありがとうございました
  382. 11400 DATA "TYOTO"  :' 24 ちょっと待って
  383. 11410 DATA "DAMEYO" :' 25 駄目よ
  384. 11420 DATA "YAMETE" :' 26 やめて
  385. 11430 DATA "TIGAU"  :' 27 ちがうよ
  386. 11440 DATA "PINPON" :' 28 ぴんぽーん
  387. 11450 DATA "BUU"    :' 29 ぶー
  388. 11460 DATA "MOUII"  :' 30 もういいよう  
  389. 11470 DATA "DEKITA" :' 31 できたよー
  390. 11480 DATA "IIDE2"  :' 32 いいですか（２）
  391. 11490 DATA "YOSI"   :' 33 よしなさい
  392. 11500 DATA "OYOSI"  :' 34 およしなさい
  393. 11510 DATA "YAMENA" :' 35 やめなさい
  394. 11520 DATA "GOMEN"  :' 36 ごめん
  395. 11530 '                                    
  396. 12000 '////////// 年月日入力 & 曜日表示
  397. 12010 '                    
  398. 12045 *週検索
  399. 12050  DATA "SUN",2,"MON",7,"TUE",7,"WED",7,"THU",7,"FRI",7,"SAT",5
  400. 12060  GOSUB *WEEKN:RESTORE 12050:FOR IW=0 TO WK:READ WKM$,CW:NEXT IW
  401. 12080  RETURN
  402. 12090 '
  403. 12450 *WEEKN :'////////// 週NO.検索    'v1.3 bugfix 93.12.27
  404. 12460  U=0    :'････････････････････････ Input; YR MN   Output; WK DN
  405. 12470  IF YR/4-INT(YR/4)=0 THEN U=1
  406. 12480  DATA 0,31,28,31,30,31,30,31,31,30,31,30,31
  407. 12490  DATA 0,31,29,31,30,31,30,31,31,30,31,30,31
  408. 12500  IF U=0 THEN RESTORE 12480 ELSE RESTORE 12490
  409. 12505 'IF MN=1 THEN MDN=0:MNDN=31:GOTO 12520
  410. 12510  MDN=0:FOR IWEKN=1 TO MN:READ DN:MDN=MDN+DN:NEXT IWEKN:'1日までの日数
  411. 12515  READ MNDN                                              :'当月の日数
  412. 12516  IF DY>MNDN THEN DY=MNDN                                :'V1.3!
  413. 12520  YDN#=MDN+YR*365+INT((YR+3)/4)+5+DY-1
  414. 12530  WK=(YDN#/7-INT(YDN#/7))*7
  415. 12540  RETURN
  416. 12550 '
  417. 12600 *年月日変更:                     'v1.3 bugfix 93.12.27
  418. 12601  GOSUB *WEEKN
  419. 12602  DY=DY+DDEF
  420. 12604  IF DY>MNDN THEN DY=1     :MDEF=+1
  421. 12606  IF DY<1    THEN DY=31    :MDEF=-1
  422. 12610  MN=MN+MDEF
  423. 12620  IF MN>12   THEN MN=MN-12 :YDEF=+1
  424. 12630  IF MN<1    THEN MN=12+MN :YDEF=-1
  425. 12640  YR=YR+YDEF
  426. 12650  IF YR<0    THEN YR=10000+YR
  427. 12660  IF YR>9999 THEN YR=YR-10000
  428. 12665  GOSUB *WEEKN
  429. 12668  DY$=RIGHT$(STR$(100+DY),2)
  430. 12670  MN$=RIGHT$(STR$(100+MN),2)
  431. 12680  YR$=RIGHT$(STR$(10000+YR),4)
  432. 12690  RETURN
  433. 12695 '
  434. 12700 *本日の日付
  435. 12705  DEF FONT "システム   12ﾄﾞｯﾄ"
  436. 12710  TY$=LEFT$(DATE$,2) :TY=VAL(TY$)
  437. 12720  IF TY<90 THEN TY=TY+2000 ELSE TY=TY+1900
  438. 12730  TY$=RIGHT$(STR$(TY),4)
  439. 12740  TM$=MID$(DATE$,4,2):TM=VAL(TM$)
  440. 12750  TD$=RIGHT$(DATE$,2):TD=VAL(TD$)
  441. 12760  YR=TY:MN=TM:DY=TD:GOSUB *週検索:IF CW=0 THEN CW=7
  442. 12770  TYMD$=TY$+"."+TM$+"."+TD$
  443. 12780  LINE(475,5)-(560,17),PSET,0,BF
  444. 12790  SYMBOL(476,6),TYMD$,.75!,.75!,7
  445. 12800  SYMBOL(542,6),WKM$,.75!,.75!,CW
  446. 12810  RETURN
  447. 12820 '
  448. 13000 '////////////////////////////////////////////////////////////////////
  449. 13001 ' LKEYIN   v1.1a 全角文字移動改良                1993.02.12 T.Komura
  450. 13002 '--------- v1.2  挿入モードの変更他全面bugFIX    1993.08.04 T.Komura
  451. 13003 '          v2.0  グラフィックモード12dot用に改造 1994.07.30 T.Komura
  452. 13004 '          v2.1  マルチカラムに改造              1994.09.02 T.Komura
  453. 13005 '          v2.2  編集文字を初期表示するように改造1995.04.29 T.Komura
  454. 13006 '
  455. 13010 *LKEYIN  :'･･･････････ 1 行全角文字入力サブルーチン
  456. 13020 '   入力 = LX,LY : 表示開始座標      LG    : 行数     
  457. 13030 '          L$(ii): 初期文字列        LP    : 行ピッチ       
  458. 13040 '          LC    : 表示文字色        lb    : 非編集行文字色
  459. 13050 '          LL    : 最大文字数        cbc    : 背景色
  460. 13060 '          LINS  : 挿入ﾓｰﾄﾞ=1  出力=L$(ii) : 入力後の文字列
  461. 13070 '         
  462. 13080  LCSRCL=6:LLINCL=4
  463. 13090  DEF FONT "システム   12ﾄﾞｯﾄ"
  464. 13100 '           CR   MR   ML  INS  DEL   BS  CAN
  465. 13120  CONSOLE 0,24,2
  466. 13130  CC$=CHR$(&H0D,&H1E,&H1F,&H1C,&H1D,&H12,&H7F,&H08,&H18)
  467. 13140 ' LMG$=SPACE$(LL):LMGD$=SPACE$(LL)          :'2.1
  468. 13150  LA$=INKEY$:IF LA$<>"" THEN 13150
  469. 13160  IF LINS=1 THEN CWDT=1 ELSE CWDT=5
  470. 13170  LCSR=0:LGC=1                               :'v2.1
  471. 13180  LINE(LX,LY)-(LX+LL*6+1,LY+11),PSET,%CBC,BF :'v2.2
  472. 13185  GET@A (LX,LY)-(LX+LL*6+1,LY+13),LMB#       :'v2.0
  473. 13190  FOR LGII=1 TO LG:LXX=LX:LYY=LY+(LGII-1)*LP :'v2.1････ 初期文字列表示
  474. 13200   PUT@A (LX,LYY)-(LX+LL*6+1,LYY+13),LMB#    :'v2.1
  475. 13210   SYMBOL(LXX,LYY),L$(LGII),.75!,.75!,LB     :'v2.1
  476. 13220  NEXT LGII                                  :'v2.1
  477. 13230 *SETLG             :'----------行セット     :'v2.1
  478. 13240  LYY=LY+(LGC-1)*LP :LM$=L$(LGC)             :'v2.1
  479. 13250   SYMBOL(LXX,LYY),L$(LGC),.75!,.75!,LC      :'v2.1
  480. 13260  LINE(LX,LYY+12)-(LX+(LL*6),LYY+12),XOR,LLINCL,BF :'v2.1
  481. 13270  LCSRX=LCSR:GOSUB *LCSRDX
  482. 13280  LMX$=LEFT$(LM$+SPACE$(LL),LL)
  483. 13290  GOSUB *LMREAD
  484. 13300  IF LMGB$="1" THEN GOSUB *LCSRDEC
  485. 13310 *IN1C:'                                  ･･････････ 1 文字入力
  486. 13320  LA$=INKEY$:IF LA$="" THEN 13320
  487. 13330  ALA=ASC(LA$):CLA=INSTR(CC$,LA$)
  488. 13340  IF CLA=0 THEN 13360
  489. 13350  ON CLA GOTO *CR,*MU,*MD,*MR,*ML,*INS,*DEL,*BS,*CAN
  490. 13360  IF KANF=1 THEN *KANJI
  491. 13370  IF ALA<&H20 THEN BEEP:GOTO *IN1C
  492. 13380  IF ALA>=&H20 AND ALA<&H80 THEN *ANK
  493. 13390  IF ALA>=&HA0 AND ALA<&HE0 THEN *ANK
  494. 13400  GOTO *KANJI
  495. 13410 *ANK :'                                  ･･････････ ANK 文字入力
  496. 13420  IF LINS=1 THEN 13440
  497. 13430  MID$(LMX$,LCSR+1,1)=LA$:GOTO 13450
  498. 13440  LMX$=LEFT$(LMX$,LCSR)+LA$+RIGHT$(LMX$,LL-LCSR)
  499. 13450  GOSUB *LCSRINC
  500. 13460  GOSUB *LMREAD1:GOSUB *LMXDSP
  501. 13470  GOTO *IN1C
  502. 13480 *KANJI :'                                ･･････････ 漢字文字入力
  503. 13490  ON KANF+1 GOTO 13500,13530
  504. 13500  KANF=1:KANW$="":KANW$=LA$
  505. 13510    IF LCSR+1>=LL THEN KANF=0:BEEP
  506. 13520    GOSUB *LCSRD:GOTO *IN1C
  507. 13530  KANF=0:KANW$=KANW$+LA$
  508. 13540    IF LINS=1 THEN 13560
  509. 13550    MID$(LMX$,LCSR+1,2)=KANW$:GOTO 13570
  510. 13560    LMX$=LEFT$(LMX$,LCSR)+KANW$+RIGHT$(LMX$,LL-LCSR)
  511. 13570    GOSUB *LCSR2INC
  512. 13580    GOSUB *LMREAD1:GOSUB *LMXDSP
  513. 13590  GOTO *IN1C
  514. 13600 *CR :GOSUB *LMREAD:GOSUB *LCSRDX         '////////// End
  515. 13610   LINE(LX,LYY+12)-(LX+(LL*6),LYY+12),XOR,LLINCL,BF     :'v2.0 :'v2.1
  516. 13620   CONSOLE 0,24,0
  517. 13630 RETURN:'----------------------------------------------------------
  518. 13640 *MU :GOSUB *LMREAD2                      '////////// up   :v2.1
  519. 13645 *MU2:GOSUB *LMBDSP:LGC=LGC-1:IF LGC<1 THEN LGC=1
  520. 13655      GOTO *SETLG
  521. 13660 *MD :GOSUB *LMREAD2                      '////////// down :v2.1
  522. 13665 *MD2:GOSUB *LMBDSP:LGC=LGC+1:IF LGC>LG THEN LGC=LG
  523. 13675      GOTO *SETLG
  524. 13680 *MR :GOSUB *LMREAD2                      '////////// Right
  525. 13685      IF LMGF$="1" THEN GOSUB *LCSR2INC:GOTO *MUD    :'v2.1
  526. 13690                        GOSUB *LCSRINC :GOTO *MUD    :'v2.1
  527. 13695 *ML :GOSUB *LMREAD2                      '////////// Left
  528. 13700      IF LMGB$="2" THEN GOSUB *LCSR2DEC:GOTO *MUD    :'v2.1
  529. 13705                        GOSUB *LCSRDEC :GOTO *MUD    :'v2.1
  530. 13710 *MUD:IF LCSC=0  THEN GOTO *IN1C          '////////// line chg.ctrl:'v2.1
  531. 13715      IF LCSC=+1 THEN GOSUB *LMREAD2:LCSR=0 :GOTO *MD2
  532. 13720      IF LCSC=-1 THEN GOSUB *LMREAD2:LCSR=LL:GOTO *MU2
  533. 13725 *INS:GOSUB *LCSRDX:LINS=1-LINS           '////////// Insert
  534. 13730      IF LINS=1 THEN CWDT=1 ELSE CWDT=5
  535. 13735      GOSUB *LCSRDX                    :GOTO *IN1C
  536. 13740 *DEL:GOSUB *LMREAD:LMX$=LEFT$(LMG$,LCSR) '////////// Delete
  537. 13745      IF LMGF$="1" THEN LDEF=2 ELSE LDEF=1
  538. 13750      LMX$=LMX$+MID$(LMG$,LCSR+LDEF+1,LL-LCSR-LDEF)+"  "
  539. 13755      GOSUB *LMREAD:GOSUB *LMXDSP      :GOTO *IN1C
  540. 13760 *BS :GOSUB *LMREAD                       '////////// BackSpace
  541. 13765      IF LCSR=0 THEN GOTO *IN1C
  542. 13770      IF LMGB$="2" THEN GOSUB *LCSR2DEC:LDEF=2:GOTO 13780
  543. 13775                        GOSUB *LCSRDEC :LDEF=1:GOTO 13780
  544. 13780      LMX$=LEFT$(LMG$,LCSR)+RIGHT$(LMG$,LL-LCSR-LDEF)+"  "
  545. 13785      GOSUB *LMREAD:GOSUB *LMXDSP      :GOTO *IN1C
  546. 13790 *CAN :LMX$=SPACE$(LL)                    '////////// Clear
  547. 13795      GOSUB *LMXDSP:LCSR=0:GOSUB *LCSRD
  548. 13800      GOSUB *LMREAD                    :GOTO *IN1C
  549. 13805 *LMREAD:                                 '////////// Disp Char Read 
  550. 13810      LMGFX$=MID$(LMGDX$,LCSR+1,1)
  551. 13815      IF LMGFX$="2" OR LMGF$="2" THEN MID$(LMX$,LCSR+1,1)=" "
  552. 13820 *LMREAD1:LMGD$=""
  553. 13825          FOR II=1 TO KLEN(LMX$)
  554. 13830            LMG=KTYPE(LMX$,II)
  555. 13835            IF LMG=0 THEN LMD$="0" ELSE LMD$="12"
  556. 13840            LMGD$=LMGD$+LMD$
  557. 13845          NEXT II
  558. 13850          IF LEN(LMGD$)<=LL THEN 13860
  559. 13855          LMGD$=LEFT$(LMGD$,LL):LMX$=LEFT$(LMX$,LL)
  560. 13860          IF RIGHT$(LMGD$,1)<>"1" THEN 13870
  561. 13865          MID$(LMGD$,LL,1)="0":MID$(LMX$,LL,1)=" "
  562. 13870 *LMREAD2:LMGF$=MID$(LMGD$,LCSR+1,1)
  563. 13875          IF LCSR=0 THEN LMGB$="0" ELSE LMGB$=MID$(LMGD$,LCSR,1)
  564. 13880          LMG$=LMX$:LMGDX$=LMGD$:L$(LGC)=LMG$
  565. 13885          RETURN
  566. 13890 *LCSRD :LXC=(LX+6*LCSR ):LYC=LYY:GOSUB *LCSRL: 'v2.0 :'v2.1//// Csr Disp
  567. 13895 *LCSRDX:LXC=(LX+6*LCSRX):LYC=LYY:GOSUB *LCSRL: 'v2.0 :'v2.1//// Csr Erace
  568. 13900         LCSRX=LCSR:RETURN
  569. 13905 *LCSRL :LINE(LXC,LYC+0)-(LXC+CWDT,LYC+12),XOR,LCSRCL,BF:RETURN
  570. 13910 *LCSRINC :LCSC=0:LCSR=LCSR+1:IF LCSR>=LL THEN LCSR=LL-1:LCSC=+1
  571. 13915           GOSUB *LCSRD:RETURN
  572. 13920 *LCSR2INC:LCSC=0:LCSR=LCSR+2:IF LCSR>=LL THEN LCSR=LL-2:LCSC=+1
  573. 13925           GOSUB *LCSRD:RETURN
  574. 13930 *LCSRDEC :LCSC=0:LCSR=LCSR-1:IF LCSR<0 THEN LCSR=0     :LCSC=-1
  575. 13935           GOSUB *LCSRD:RETURN
  576. 13940 *LCSR2DEC:LCSC=0:LCSR=LCSR-2:IF LCSR<0 THEN LCSR=LCSR+2:LCSC=-1
  577. 13945           GOSUB *LCSRD:RETURN
  578. 13950 *LMXDSP  :PUT@A (LX,LYY)-(LX+LL*6+1,LYY+13),LMB#    :'v2.0   :'v2.1
  579. 13955           LINE(LX,LYY+12)-(LX+(LL*6),LYY+12),XOR,LLINCL,BF   :'v2.0
  580. 13960           SYMBOL(LX,LYY),LMX$,.75!,.75!,LC
  581. 13965           GOSUB *LCSRDX:RETURN
  582. 13970 *LMBDSP  :PUT@A (LX,LYY)-(LX+LL*6+1,LYY+13),LMB#    :'v2.1
  583. 13975           SYMBOL(LX,LYY),LMX$,.75!,.75!,LB:RETURN   :'v2.1
  584. 13980 '-------------------------------------------------------------------
  585. 14000 'マウス,ウインドウ関係サブルーチン集   v1.0 1995.05.14
  586. 14010 '--------------------------------------------------
  587. 14020 '
  588. 14030 'マウスカーソル形状セット   v1.0 1994.02.13
  589. 14040 *MCDSET
  590. 14050  MOUSE 2,MCAND$(MCN),MCDOT$(MCN),MC_X(MCN),MC_Y(MCN)
  591. 14060  RETURN
  592. 14070 *MCREAD
  593. 14080  RESTORE *MCDATA
  594. 14090  FOR II=1 TO 3
  595. 14100    FOR JJ=1 TO 32:MCAND$(II)="":MCDOT$(II)="":NEXT JJ
  596. 14110    READ MC_X(II),MC_Y(II)
  597. 14120    FOR JJ=1 TO 32:READ MCAND:MCAND$(II)=MCAND$(II)+CHR$(MCAND):NEXT JJ
  598. 14130    FOR JJ=1 TO 32:READ MCDOT:MCDOT$(II)=MCDOT$(II)+CHR$(MCDOT):NEXT JJ
  599. 14140  NEXT II
  600. 14150  RETURN
  601. 14160 *MCDATA
  602. 14170 '指 ////////////////////////////////////////
  603. 14171 DATA 0,0
  604. 14172 DATA &H1F,&HFF,&H0F,&HFF,&H07,&HFF,&H83,&HFF' and
  605. 14173 DATA &HC0,&H3F,&HE0,&H07,&HF0,&H01,&HF8,&H00
  606. 14174 DATA &HF0,&H00,&HE0,&H00,&HE0,&H00,&HE0,&H00
  607. 14175 DATA &HE0,&H00,&HF0,&H00,&HF8,&H00,&HFC,&H00
  608. 14176 DATA &H00,&H00,&H60,&H00,&H30,&H00,&H18,&H00' dot
  609. 14177 DATA &H0C,&H00,&H06,&H80,&H03,&H50,&H01,&HAA
  610. 14178 DATA &H05,&HFE,&H04,&HFE,&H06,&HFE,&H07,&HFE
  611. 14179 DATA &H03,&HFF,&H01,&HFF,&H00,&H7F,&H00,&H1F
  612. 14180 'コーヒー///////////////////////////////////
  613. 14181 DATA 7,7
  614. 14182 DATA &HFF,&HFF,&HF2,&H4F,&HE4,&H9F,&HE4,&H9F' and
  615. 14183 DATA &HE6,&H1F,&HF2,&H4F,&HC0,&H07,&HC0,&H01
  616. 14184 DATA &HC0,&H06,&HC0,&H06,&HC0,&H05,&HC0,&H03
  617. 14185 DATA &HE0,&H0F,&H80,&H01,&HC0,&H03,&HE0,&H07
  618. 14186 DATA &H00,&H00,&H04,&H90,&H09,&H20,&H09,&H20' dot
  619. 14187 DATA &H08,&HA0,&H04,&H90,&H00,&H00,&H1F,&HF0
  620. 14188 DATA &H15,&HF0,&H13,&H30,&H15,&H30,&H1F,&HF0
  621. 14189 DATA &H0F,&HE0,&H00,&H00,&H1F,&HF8,&H00,&H00
  622. 14190 '待った //////////////////////////////////////
  623. 14191 DATA 7,7
  624. 14192 DATA &HF0,&H1F,&HC0,&H07,&H80,&H03,&H80,&H03' and
  625. 14193 DATA &H00,&H01,&H00,&H01,&H00,&H01,&H00,&H01
  626. 14194 DATA &H00,&H01,&H00,&H01,&H00,&H01,&H80,&H03
  627. 14195 DATA &H80,&H03,&HC0,&H07,&HF0,&H1F,&HFF,&HFF
  628. 14196 DATA &H00,&H00,&H00,&H00,&H07,&HC0,&H1F,&H80' dot
  629. 14197 DATA &H1F,&H00,&H3E,&H08,&H3C,&H18,&H38,&H38
  630. 14198 DATA &H30,&H78,&H20,&HF8,&H01,&HF0,&H03,&HF0
  631. 14199 DATA &H07,&HC0,&H00,&H00,&H00,&H00,&H00,&H00
  632. 14200 '
  633. 14210 *MCDRAG 'ドラッグ -----------------------------------------------
  634. 14220  MOUSE 1,X_M,Y_M,1                            :'現在位置にカーソルを設定
  635. 14225  MD_XB1=W_X1(G):MD_YB1=W_Y1(G) :MD_XC1=W_X1(G):MD_YC1=W_Y1(G) :'旧ｳｲﾝﾄﾞｳ座標保持
  636. 14230  MD_XB2=W_X2(G):MD_YB2=W_Y2(G) :MD_XC2=W_X2(G):MD_YC2=W_Y2(G) :'旧ｳｲﾝﾄﾞｳ座標保持
  637. 14235  GET@A(MD_XB1,MD_YB1)-(MD_XB2,MD_YB2),MD_SW#
  638. 14238  X1=X_M-W_X1(G)+W_XA(G):X2=X_M+W_XB(G)-W_X2(G):'最大移動域の設定
  639. 14239  Y1=Y_M-W_Y1(G)+W_YA(G):Y2=Y_M+W_YB(G)-W_Y2(G):'
  640. 14240  MOUSE 4,X1,Y1,X2,Y2                          :'最大移動域の設定
  641. 14245  GOSUB *MD_WLINED
  642. 14250  IF MOUSE(2,0)=-1 THEN 14245                  :'枠移動
  643. 14255   LINE(MD_XC1,MD_YC1)-(MD_XC2,MD_YC2),XOR,4,B,&HCCCC     :'枠線消去
  644. 14260  PUT@A(MD_XB1,MD_YB1)-(MD_XB2,MD_YB2),MD_SB#      :'旧ｳｲﾝﾄﾞｳ背景表示
  645. 14265  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#  :'新ｳｲﾝﾄﾞｳ背景保持
  646. 14270  PUT@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SW#  :'新ｳｲﾝﾄﾞｳ描画
  647. 14275  MOUSE 4,0,0,639,479:WAIT SWAIT\4+1:RETURN
  648. 14280 *MD_WLINED
  649. 14285  MD_X_M=MOUSE(9) :MD_Y_M=MOUSE(10)                :'移動量取得
  650. 14290  W_X1(G)=W_X1(G)+(MD_X_M):W_Y1(G)=W_Y1(G)+(MD_Y_M):'新座標計算
  651. 14295  W_X2(G)=W_X2(G)+(MD_X_M):W_Y2(G)=W_Y2(G)+(MD_Y_M)
  652. 14300  LINE(MD_XC1 ,MD_YC1 )-(MD_XC2 ,MD_YC2 ),XOR,4,B,&HCCCC  :'枠線移動
  653. 14305  LINE(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),XOR,4,B,&HCCCC
  654. 14310  MD_XC1=W_X1(G):MD_YC1=W_Y1(G)
  655. 14315  MD_XC2=W_X2(G):MD_YC2=W_Y2(G)
  656. 14320  RETURN
  657. 14400 '------------------------------------------------------------------
  658. 14405 *ボタン座標読み取り
  659. 14410  RESTORE *ボタン座標:READ SWGN
  660. 14415  FOR G=1 TO SWGN
  661. 14420    READ SWN(G), W_X1(G),W_X2(G),W_Y1(G),W_Y2(G), W_XA(G),W_XB(G),W_YA(G),W_YB(G)
  662. 14425    FOR B=1 TO SWN(G):READ B_X1(G,B),B_X2(G,B),B_Y1(G,B),B_Y2(G,B):NEXT B
  663. 14430  NEXT G
  664. 14435  RETURN
  665. 14500 '-----------------------------------------------------------------
  666. 14505 *BTN_ONOFF:'ボタンON_OFF表示
  667. 14510  IF BST(G,B)=1 THEN BSC=15:BSB=1:GOTO 14520
  668. 14515                     BSC=1:BSB=15
  669. 14520   X1=W_X1(G)+B_X1(G,B):X2=W_X1(G)+B_X2(G,B)
  670. 14521   Y1=W_Y1(G)+B_Y1(G,B):Y2=W_Y1(G)+B_Y2(G,B)
  671. 14522   CONNECT(X1,Y2)-(X2,Y2)-(X2,Y1),%BSC,PSET
  672. 14523   CONNECT(X1,Y2)-(X1,Y1)-(X2,Y1),%BSB,PSET
  673. 14530  IF BSNDOFF=1 THEN 14540 :'                 WAIT SWAIT\10+1:GOTO 14540
  674. 14535  IF BST(G,B)=1 THEN SMSGPLAY 0:WAIT SWAIT\5+1
  675. 14540  BSNDOFF=0:RETURN
  676. 14600 '-----------------------------------------------------------------
  677. 14610 *MCSELECT:'マウスボタン選択
  678. 14620  SWERC=0:SWNO=0                         :'リセット
  679. 14630 *クリック待ち
  680. 14635  IF CDSPQUE=1 THEN RETURN
  681. 14640  IF MOUSE(2,0)=-1 THEN 14680            :'左クリック入力待ち
  682. 14650  IF MOUSE(2,1)=-1 THEN SWNO=-1:RETURN   :'右クリックで終了
  683. 14660  IF MCKEY=1 THEN GOTO 14830             :'MCKEY=1: マウススキャン中断､キー入力受付
  684. 14670  GOTO *クリック待ち
  685. 14680  X_M=MOUSE(4,0):Y_M=MOUSE(5,0)          :'座標取得
  686. 14690  FOR IMS=1 TO SWN(G)                    :'ボタン座標判定
  687. 14700    IF (X_M>W_X1(G)+B_X1(G,IMS)) AND (X_M<W_X1(G)+B_X2(G,IMS)) ELSE 14730
  688. 14710    IF (Y_M>W_Y1(G)+B_Y1(G,IMS)) AND (Y_M<W_Y1(G)+B_Y2(G,IMS)) ELSE 14730
  689. 14720    SWNO=IMS:IMS=SWN(G)+1
  690. 14730  NEXT IMS
  691. 14735  WAIT SWAIT\8+1 'FOR II=1 TO 500:NEXT II
  692. 14740  IF (SWPASS=1) OR (SWNO<>0) THEN 14830
  693. 14750  IF SWNO=0 THEN
  694. 14760     GOSUB *MCMIS:SWERC=SWERC+1           '誤指定警告表示
  695. 14770     IF SWERC>5 THEN
  696. 14780       MCN=3:GOSUB *MCDSET:MESN=12:GOSUB *SNDMSG            '誤指定警告音声案内
  697. 14790       MCN=1:GOSUB *MCDSET
  698. 14800     ENDIF
  699. 14810  ENDIF
  700. 14820  GOTO *クリック待ち
  701. 14830  SWPASS=0:SW1T=0:MCKEY=0
  702. 14840  RETURN
  703. 14850 *MCMIS
  704. 14860  MCN=3:GOSUB *MCDSET:WAIT SWAIT\3+1:MCN=1:GOSUB *MCDSET
  705. 14870  RETURN
  706. 14880 '
  707. 14890 '
  708. 15000 '
  709. 15010 '  SAVE"TCLOCK.sub"             :'   組み込み型 アナログ時計 V1.1
  710. 15020 '                                       1991.05 T.KOMURA 
  711. 15030 '--------------------------------------------------------------------
  712. 15040 '
  713. 15220 *時計表示:'///////////////////////////////////
  714. 15230  XCLK0=579:YCLK0=11:CLKR=9:PI=3.1415!
  715. 15240  TIMEX$=TIME$:IF DATE$<>DATX$ THEN GOSUB *本日の日付
  716. 15250  TSC$=MID$(TIMEX$,7,2):SCR=2*PI*(VAL(TSC$)/60)
  717. 15260  TMN$=MID$(TIMEX$,4,2):MNR=2*PI*(VAL(TMN$)/60)
  718. 15270  THR$=LEFT$(TIMEX$,2) :HRR=2*PI*((VAL(THR$)*60+VAL(TMN$))/720)
  719. 15280  GOSUB *短針表示
  720. 15290  GOSUB *長針表示
  721. 15300  GOSUB *秒針表示
  722. 15305  IF DCLOCKF=1 THEN GOSUB *DCLOCKD
  723. 15310  CLOCKINIT=1:DATX$=DATE$
  724. 15315  IF CCHGF=0 THEN 15320
  725. 15316  IF TIME-CCHGT>CCHGINT THEN CDSPQUE=1
  726. 15320  RETURN
  727. 15330 '
  728. 15340 *短針表示
  729. 15350  XHD1=XCLK0+(CLKR*.6!)*SIN(HRR):XHD2=XCLK0
  730. 15360  YHD1=YCLK0-(CLKR*.6!)*COS(HRR):YHD2=YCLK0
  731. 15370  IF CLOCKINIT=0 THEN 15400
  732. 15380  IF SCR<>0 THEN 15420
  733. 15390  LINE(XHD1X,YHD1X)-(XHD2X,YHD2X),XOR,6
  734. 15400  LINE(XHD1 ,YHD1 )-(XHD2 ,YHD2 ),XOR,6
  735. 15410  XHD1X=XHD1:YHD1X=YHD1:XHD2X=XHD2:YHD2X=YHD2
  736. 15420  RETURN
  737. 15430 *長針表示
  738. 15440  XMD1=XCLK0+(CLKR*.8!)*SIN(MNR):XMD2=XCLK0
  739. 15450  YMD1=YCLK0-(CLKR*.8!)*COS(MNR):YMD2=YCLK0
  740. 15460  IF CLOCKINIT=0 THEN 15490
  741. 15470  IF SCR<>0 THEN 15510
  742. 15480  LINE(XMD1X,YMD1X)-(XMD2X,YMD2X),XOR,7
  743. 15490  LINE(XMD1 ,YMD1 )-(XMD2 ,YMD2 ),XOR,7
  744. 15500  XMD1X=XMD1:YMD1X=YMD1:XMD2X=XMD2:YMD2X=YMD2
  745. 15510  RETURN
  746. 15520 *秒針表示
  747. 15530  XSD1=XCLK0+(CLKR)*SIN(SCR):XSD2=XCLK0:'+(CLKR-10)*SIN(SCR)
  748. 15540  YSD1=YCLK0-(CLKR)*COS(SCR):YSD2=YCLK0:'-(CLKR-10)*COS(SCR)
  749. 15550  IF CLOCKINIT=0 THEN 15570
  750. 15560  LINE(XSD1X,YSD1X)-(XSD2X,YSD2X),XOR,4
  751. 15570  LINE(XSD1 ,YSD1 )-(XSD2 ,YSD2 ),XOR,4
  752. 15580  XSD1X=XSD1:YSD1X=YSD1:XSD2X=XSD2:YSD2X=YSD2
  753. 15590  RETURN
  754. 15600 '////////////////////////////////////////////////////////////////////
  755. 15605 ' DIGITAL CLOCK v1.0 1995.05.24 T.Komura
  756. 15610 *DCLOCKREAD:'プログラム先頭で実施
  757. 15615  RESTORE *DCLOCKDATA
  758. 15620  FOR DGII=0 TO 9:FOR DGN=1 TO 7:READ DGP(DGII,DGN):NEXT:NEXT 
  759. 15625  FOR DGII=1 TO 9:READ DGX(DGII),DGY(DGII):NEXT
  760. 15630  FOR DGII=1 TO 4:READ DGO(DGII):NEXT
  761. 15635  RETURN
  762. 15640 *DGCLOCK:'デジタル時計 -------------------------------
  763. 15645  G=6:SWNOX=SWNO:DGINIT=0:DGFC=15:DGBC=1
  764. 15650  GOSUB *DCLOCKLOAD:GOSUB *DCLOCKD:DCLOCKF=1
  765. 15655 *DGMCSEL
  766. 15660  GOSUB *MCSELECT:'マウスボタン選択
  767. 15665  IF SWNO=0 THEN *DGMCSEL
  768. 15670  IF SWNO<0 THEN SWNO=1:'右クリックで終了
  769. 15675 '             end  drag
  770. 15680  ON SWNO GOTO *DGS01,*DGS02 
  771. 15685 *DGS02:'drag
  772. 15690  DCLOCKF=0
  773. 15692  GOSUB *MCDRAG
  774. 15694  DCLOCKF=1
  775. 15695  GOTO *DGMCSEL
  776. 15700 *DGS01:'end
  777. 15705  B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  778. 15710  DCLOCKF=0
  779. 15715  GOSUB *DCLOCKCLR
  780. 15720  SWNO=SWNOX
  781. 15725  RETURN
  782. 15730 *DCLOCKLOAD
  783. 15735  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  784. 15740  MOUSE 1,,,0
  785. 15745  LOAD@ TIFDRV$+"\dclock.tif",(W_X1(G),W_Y1(G)):MOUSE 1,,,1
  786. 15750  MOUSE 1,,,1:RETURN
  787. 15760 *DCLOCKCLR
  788. 15765  PUT@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  789. 15770  RETURN
  790. 15775 '
  791. 15780 *DCLOCKD
  792. 15785  IF DGINIT=1 THEN 15795
  793. 15790  FOR DGII=1 TO 4:DGM(DGII)=10:NEXT DGII:DGINIT=1
  794. 15795  DG(1)=VAL(MID$(TIME$,1,1)):DG(2)=VAL(MID$(TIME$,2,1))
  795. 15800  DG(3)=VAL(MID$(TIME$,4,1)):DG(4)=VAL(MID$(TIME$,5,1))
  796. 15805  DGPT=1-DGPT
  797. 15810  FOR DGII=1 TO 4
  798. 15815    IF DG(DGII)=DGM(DGII) THEN 15840
  799. 15820    FOR DGJJ=1 TO 7
  800. 15825      IF DGP(DG(DGII),DGJJ)=1 THEN DGC=DGFC ELSE DGC=DGBC
  801. 15826      IF DGII=1 AND DG(1)=0 THEN DGC=DGBC
  802. 15830      PAINT(W_X1(G)+DGX(DGJJ)+DGO(DGII),W_Y1(G)+DGY(DGJJ)),%DGC,0
  803. 15835    NEXT DGJJ
  804. 15840  NEXT DGII
  805. 15841      IF DGPT=1 THEN DGC=10 ELSE DGC=DGBC
  806. 15842      PAINT(W_X1(G)+DGX(8),W_Y1(G)+DGY(8)),%DGC,0
  807. 15843      PAINT(W_X1(G)+DGX(9),W_Y1(G)+DGY(9)),%DGC,0
  808. 15845  FOR DGII=1 TO 4:DGM(DGII)=DG(DGII):NEXT DGII'
  809. 15850  RETURN
  810. 15855 '
  811. 18000 '------------------------------------------------------------------
  812. 18005 *HKHELP:'             Copyrigit(C) T.Komura / HK2               /
  813. 18010 '   Version 1.0  1994.07.30                 / helpプログラム    /
  814. 18011 '   Version 2.0  1995.07.30 HK2ドラッグ対応
  815. 18015 'メインルーチン:'･･･････････････････････････････････････････････････
  816. 18016 G=5:SWNOX=SWNO:DOCDC=6:DOCBC=8
  817. 18020 GOSUB *DOCTIFDSP:GOSUB *DOCFREAD
  818. 18026 MCN=1:GOSUB *MCDSET
  819. 18030 GOSUB *DOC初期表示
  820. 18035 *DC_MSINSEL
  821. 18040 SWPASS=1:GOSUB *MCSELECT:'マウスボタン選択
  822. 18042 IF SWNO=0 THEN GOSUB *DC_他エリア判定
  823. 18043 IF SWNO<0 THEN SWNO=5:'右クリックで終了
  824. 18045 IF SWNO>7 OR SWNO=0 THEN *DC_MSINSEL
  825. 18050 IF SWNO=5 THEN GOTO *SDC_05
  826. 18055 IF SWNO=6 THEN GOTO *SDC_06
  827. 18060 IF SWNO=7 THEN GOTO *SDC_07
  828. 18065                GOTO *DOCCTRL
  829. 18070 *DOCCTRL
  830. 18075  B=SWNO:BST(G,B)=1:BSNDOFF=1:GOSUB *BTN_ONOFF
  831. 18080   DCCD=SWNO:GOSUB *DOC表示制御
  832. 18085  B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  833. 18090  GOTO *DC_MSINSEL
  834. 18095 *SDC_06:       GOSUB *MCDRAG     :GOTO *DC_MSINSEL
  835. 18100 *SDC_07:DCCD=5:GOSUB *DOC表示制御:GOTO *DC_MSINSEL
  836. 18105 *SDC_05:'終了
  837. 18110  B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  838. 18115  PUT@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  839. 18120  DOCCS=0:SWNO=SWNOX
  840. 18122  RETURN:'///////////////////////////////////////////////////
  841. 18125 '
  842. 18130 'sub routine---------------------------------------------
  843. 18135 *DOCTIFDSP
  844. 18137  MOUSE 1,,,0
  845. 18140  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  846. 18145  LOAD@ TIFDRV$+"\hk2help.tif",(W_X1(G),W_Y1(G))
  847. 18165  MOUSE 1,,,1:GOSUB *DOC名称表示
  848. 18170  RETURN
  849. 18175 *DOCFREAD:'helpファイル読み込み
  850. 18177  MCN=2:GOSUB *MCDSET
  851. 18180  DOCN=0:OPEN "I",#1,PRGDRV$+"\HELPF"+DOCF$
  852. 18185  IF EOF(1)=-1 THEN 18200
  853. 18190  DOCN=DOCN+1:LINE INPUT #1,DOC$(DOCN)
  854. 18195  GOTO 18185
  855. 18200  CLOSE #1:RETURN
  856. 18205 *DOC指定行表示
  857. 18210  GOSUB *DOCカーソル表示
  858. 18220  FOR DN=SDN TO EDN
  859. 18225    XDC=W_X1(G)+8:YDC=W_Y1(G)+27+DCL*12
  860. 18230    SYMBOL(XDC,YDC),DOC$(DN),.75!,.75!,7
  861. 18235    DCL=DCL+1
  862. 18240  NEXT DN:RETURN
  863. 18245 *DOC初期表示
  864. 18250  SDN=1:EDN=24:DCL=0:DSP=1:GOSUB *DOC指定行表示
  865. 18255  RETURN
  866. 18260 *DOC表示制御:'///////////////////////////////////////
  867. 18265  ON DCCD GOTO *DCC3,*DCC1,*DCC2,*DCC4,*DCC5
  868. 18270 *DCC1:'------ 前行
  869. 18275  DSP=DSP-1 :IF DSP<1 THEN DSP=1          :RETURN
  870. 18280  SDN=DSP   :GOSUB *DOC下シフト
  871. 18285  EDN=SDN   :DCL=0 :GOSUB *DOC指定行表示  :RETURN
  872. 18290 *DCC2:'------ 次行
  873. 18295  DSP=DSP+1 :IF DSP+23>DOCN THEN DSP=DSP-1:RETURN
  874. 18300  SDN=DSP+23: GOSUB *DOC上シフト
  875. 18305  EDN=SDN   :DCL=23:GOSUB *DOC指定行表示  :RETURN
  876. 18310 *DCC3:'------ 前頁
  877. 18315  DSP=DSP-24:IF DSP<1 THEN DSP=1
  878. 18320  GOTO *DCC51
  879. 18325 *DCC4:'------ 次頁
  880. 18330  DSP=DSP+24:IF DSP>DOCN THEN DSP=(DOCN\24)*24+1
  881. 18335  GOTO *DCC51
  882. 18340 *DCC5:'------ カーソル指定
  883. 18345  DSP=((INT(DOCN*DOCR))\24)*24+1
  884. 18350  IF DSP>DOCN THEN DSP=(DOCN\24)*24+1
  885. 18355 *DCC51
  886. 18360  SDN=DSP   :EDN=SDN+23
  887. 18365  IF EDN>DOCN THEN EDN=EDN-1:GOTO 18365
  888. 18370  LINE (W_X1(G)+6,W_Y1(G)+27)-(W_X1(G)+492,W_Y1(G)+27+12*24),PSET,%DOCBC,BF
  889. 18375  DCL=0:GOSUB *DOC指定行表示              :RETURN
  890. 18380 '------------------------------------------------------
  891. 18385 *DOC上シフト
  892. 18386  X1=W_X1(G)+6:Y1=W_Y1(G)+27 :X2=W_X1(G)+492:Y2=Y1
  893. 18390  GET@A(X1,Y1+12*1 )-(X2,Y2+12*24),HLPC#
  894. 18395  LINE (X1,Y1+12*23)-(X2,Y2+12*24),PSET,%DOCBC,BF
  895. 18400  PUT@A(X1,Y1      )-(X2,Y2+12*23),HLPC#
  896. 18405  RETURN
  897. 18410 *DOC下シフト
  898. 18411  X1=W_X1(G)+6:Y1=W_Y1(G)+27 :X2=W_X1(G)+492:Y2=Y1
  899. 18415  GET@A(X1,Y1     )-(X2,Y2+12*23),HLPC#
  900. 18420  LINE (X1,Y1     )-(X2,Y2+12*1 ),PSET,%DOCBC,BF
  901. 18425  PUT@A(X1,Y1+12*1)-(X2,Y2+12*24),HLPC#
  902. 18430  RETURN
  903. 18435 *DOCカーソル表示
  904. 18440  XDC1 =W_X1(G)+500:XDC2=W_X1(G)+511
  905. 18445  YDC1 =W_Y1(G)+53+INT(233*((DSP-1)  /DOCN))
  906. 18450  YDC2 =W_Y1(G)+53+INT(233*((DSP+23) /DOCN))
  907. 18451  A=W_Y1(G)+B_Y1(G,3):IF YDC2>=A  THEN YDC2=A-1
  908. 18455  YDC1X=W_Y1(G)+53+INT(233*((DSPX-1) /DOCN))
  909. 18460  YDC2X=W_Y1(G)+53+INT(233*((DSPX+23)/DOCN))
  910. 18461  A=W_Y1(G)+B_Y1(G,3):IF YDC2X>=A THEN YDC2X=A-1
  911. 18465  IF DOCCS=1 THEN 18470 ELSE DOCCS=1:GOTO 18475
  912. 18470  LINE(XDC1,YDC1X)-(XDC2,YDC2X),XOR,5,BF
  913. 18475  LINE(XDC1,YDC1 )-(XDC2,YDC2 ),XOR,5,BF
  914. 18480  DSPX=DSP :RETURN
  915. 18485 *DOC名称表示
  916. 18490  XDC=W_X1(G)+427:YDC=W_Y1(G)+7
  917. 18495  DOCD$=RIGHT$(DOCF$,LEN(DOCF$)-1)
  918. 18500  SYMBOL(XDC,YDC),DOCD$,.75!,.75!,%DOCDC
  919. 18505  RETURN
  920. 18810 *DC_他エリア判定
  921. 18830  IF (X_M>(W_X1(G)+499) AND X_M<(W_X1(G)+512)) ELSE 18845
  922. 18835  IF (Y_M>(W_Y1(G)+ 53) AND Y_M<(W_Y1(G)+288)) ELSE 18845
  923. 18840  DOCR=(Y_M-(W_Y1(G)+53))/235:SWNO=7
  924. 18845  RETURN
  925. 18850 '
  926. 19000 '
  927. 19010 '//////////////////////////////////////////////////////////////
  928. 19020 *ERROR:'      エラー処理サブルーチン V1.10   1990.11.08 T.Komura
  929. 19030 '             
  930. 19040 '
  931. 19050 IF ERR=53 THEN *IOERR
  932. 19060 IF ERR=63 THEN *FILNOF
  933. 19070 IF ERR=67 THEN *DSKFUL
  934. 19080 IF ERR=71 THEN *DSKUNF 
  935. 19090 IF ERR=72 THEN *DSKOFF
  936. 19100 IF ERR=73 THEN *DSKWP
  937. 19110 ERMES$="エラー行:"+STR$(ERL)+" エラー番号:"+STR$(ERR)+" 発生"
  938. 19120 GOSUB *ERMSG
  939. 19130 STOP
  940. 19140 '////////// エラー処理
  941. 19150 *IOERR
  942. 19160 ERMES$="ﾌﾟﾘﾝﾀｰが準備されていません｡ ﾌﾟﾘﾝﾀｰをセット後､"
  943. 19170 GOSUB *ERMSG:RESUME
  944. 19180 *DSKFUL
  945. 19190 ERMES$="ディスクが満杯です｡ 交換後､"
  946. 19200 GOSUB *ERMSG:RESUME
  947. 19210 *DSKUNF
  948. 19220 ERMES$="このディスクは使用出来ません｡処理を中断します｡ "
  949. 19230 GOSUB *ERMSG:RESUME
  950. 19240 *DSKOFF
  951. 19250 ERMES$="ディスク装置が準備されていません｡ディスクをセット後､"
  952. 19260 GOSUB *ERMSG:RESUME
  953. 19270 *DSKWP
  954. 19280 ERMES$="ディスクが書き込み禁止になっています｡解除後､"
  955. 19290 GOSUB *ERMSG:RESUME
  956. 19300 *FILNOF
  957. 19310 ERMES$="ファイルが見つかりません｡ディスクを交換後､"
  958. 19320 GOSUB *ERMSG:RESUME
  959. 19330 '
  960. 19340 *ERMSG:'////////// エラーメッセージ
  961. 19355 LINE(0,465)-(639,479),PSET,0,BF
  962. 19360 SYMBOL(0,465),ERMES$+"[実行]キーを押してね！",.75!,.75!,2
  963. 19370 COLOR 7,0:MESN=19:GOSUB *SNDMSG
  964. 19380 ERRA$=INKEY$:IF ERRA$="" THEN 19380
  965. 19390 IF ERRA$<>CHR$(&H0D) THEN 19380
  966. 19400 LINE(0,465)-(639,479),PSET,0,BF
  967. 19410 SYMBOL(0,465),"エラー処理を終わります｡",.75!,.75!,6
  968. 19420 RETURN
  969. 19430 '
  970. 19440 '
  971. 19450 '
  972. 20000 '------------------------------------------------------------------
  973. 20010 ' ＣＵＳＴＯＭ　ＳＵＢ　ＲＯＵＴＩＮＥ FOR "CALEND.BAS"
  974. 20020 '------------------------------------------------------------------
  975. 20100 *表紙表示
  976. 20110  GOSUB *EVGET
  977. 20120  LOAD@ TIFDRV$+"\hk2cld.TIF",(0,0)
  978. 20130  DEF FONT "システム   12ﾄﾞｯﾄ"
  979. 20135  G=1:B=5:BST(G,B)=1:BSNDOFF=1:GOSUB *BTN_ONOFF
  980. 20140  MESN=1:GOSUB *MESDSP
  981. 20145  INTERVAL ON
  982. 20150  GET@A(22,156)-(421,392),MAT#
  983. 20160  RETURN
  984. 20190 '
  985. 20290 '
  986. 20300 *メイン年月表示
  987. 20302  GOSUB *メイン年表示
  988. 20304  GOSUB *メイン月表示
  989. 20306  RETURN
  990. 20310  *メイン年表示
  991. 20315   YR=VAL(YR$):NBA$=YR$:NBN=4:GOSUB *数字漢字変換:DSYR$=NBK$
  992. 20320   LINE(22,100)-(115,117),PSET,0,BF
  993. 20321   DEF FONT "システム   16ﾄﾞｯﾄ"
  994. 20322   SYMBOL(28,101),DSYR$+"年",1,1,7,,,&H01
  995. 20324   DEF FONT "システム   12ﾄﾞｯﾄ"
  996. 20325   RETURN
  997. 20330  *メイン月表示
  998. 20335   MN=VAL(MN$):NBA$=MN$:NBN=2:GOSUB *数字漢字変換:DSMN$=NBK$
  999. 20340   LINE(194,95)-(255,121),PSET,0,BF
  1000. 20345   DEF FONT "ゴシック体 24ﾄﾞｯﾄ"
  1001. 20350   SYMBOL(192,97),DSMN$,1.5!,1.5!,7
  1002. 20352   DEF FONT "システム   16ﾄﾞｯﾄ"
  1003. 20355   SYMBOL(240,101),"月",1,1,7,,PSET,&H01
  1004. 20360   DEF FONT "システム   12ﾄﾞｯﾄ":RETURN
  1005. 20390 '
  1006. 20400 *本日のカレンダー表示
  1007. 20410  YR$=TY$:MN$=TM$:MN$=RIGHT$("  "+STR$(VAL(MN$)),2)
  1008. 20420  GOSUB *メイン年月表示
  1009. 20425 *指定カレンダー表示
  1010. 20426  MCN=2:GOSUB *MCDSET
  1011. 20430  GOSUB *メインカレンダー表示
  1012. 20440  GOSUB *サブカレンダー表示
  1013. 20445  MCN=1:GOSUB *MCDSET
  1014. 20446  CDSPF=1
  1015. 20450  RETURN
  1016. 20460 '
  1017. 20470 *メインカレンダー表示
  1018. 20480  X0=40:Y0=160:XP=56:YP=37
  1019. 20485  FOR CLX=0 TO 6:FOR CLY=0 TO 5:CLM(CLX,CLY)=0:NEXT:NEXT
  1020. 20490  INTERVAL OFF
  1021. 20500  DY=1:GOSUB *WEEKN
  1022. 20510  PUT@A(22,156)-(421,392),MAT#
  1023. 20520  FOR IDSP=0 TO MNDN-1:COLOR 7,7
  1024. 20530    CLDD$=RIGHT$("  "+STR$(IDSP+1),2)
  1025. 20540    NBA$=CLDD$:NBN=2:GOSUB *数字漢字変換:CLDD$=NBK$
  1026. 20542    CLX=(WK+IDSP) MOD 7
  1027. 20544    CLY=INT((WK+IDSP)/7)
  1028. 20546    CLM(CLX,CLY)=IDSP+1
  1029. 20550    CLDC=0:CLDX=X0+CLX*XP:CLDY=Y0+CLY*YP
  1030. 20552    IF CLX=0 THEN CLDC=2
  1031. 20554    IF CLX=6 THEN CLDC=1
  1032. 20556    GOSUB *祝日検出
  1033. 20557    DEF FONT "システム 16ﾄﾞｯﾄ"
  1034. 20560    SYMBOL(CLDX-10,CLDY),LEFT$(CLDD$,2),1.5!,2,CLDC,,,&H01
  1035. 20561    SYMBOL(CLDX+8,CLDY),RIGHT$(CLDD$,2),1.5!,2,CLDC,,,&H01
  1036. 20562    DEF FONT "システム 12ﾄﾞｯﾄ"
  1037. 20565    IF EVEX=0 THEN 20570
  1038. 20566    IF INSTR(CLEV$,"誕生")<>0 THEN MKCL=10 ELSE MKCL=12
  1039. 20567    SYMBOL(CLDX+30,CLDY+2),"★",.5!,.5!,%MKCL
  1040. 20570  NEXT IDSP:COLOR 7,0
  1041. 20580  INTERVAL ON
  1042. 20590  RETURN
  1043. 20595 '
  1044. 20600 *サブカレンダー表示
  1045. 20610  MDEF=-1:YDEF=0:GOSUB *年月日変更
  1046. 20620  GOSUB *前月表示
  1047. 20630  MDEF=+2:YDEF=0:GOSUB *年月日変更
  1048. 20640  GOSUB *次月表示
  1049. 20650  MDEF=-1:YDEF=0:GOSUB *年月日変更
  1050. 20660  RETURN
  1051. 20670 '
  1052. 20700 *前月表示
  1053. 20704  DEF FONT "システム   16ﾄﾞｯﾄ"
  1054. 20705  LINE(505,101)-(618,117),PSET,%8,BF
  1055. 20710  SYMBOL(520,102),YR$+"年 "+MN$+"月",1,1,%6
  1056. 20720  X0=438:Y0=128:XP=24:YP=16 
  1057. 20725  GOSUB *ミニカレンダー表示
  1058. 20730  RETURN
  1059. 20740 *次月表示
  1060. 20741  DEF FONT "システム   16ﾄﾞｯﾄ"
  1061. 20742  LINE(505,253)-(618,269),PSET,%8,BF
  1062. 20745  SYMBOL(520,254),YR$+"年 "+MN$+"月",1,1,%6
  1063. 20750  X0=438:Y0=280:XP=24:YP=16
  1064. 20755  GOSUB *ミニカレンダー表示
  1065. 20760  RETURN
  1066. 20800 *ミニカレンダー表示
  1067. 20810  INTERVAL OFF
  1068. 20815  DY=1:GOSUB *WEEKN
  1069. 20820  LINE(X0,Y0)-(X0+180,Y0+112),PSET,%0,BF
  1070. 20825  FOR IDSP=0 TO MNDN-1
  1071. 20830    CLX=(WK+IDSP) MOD 7
  1072. 20840    CLY=INT((WK+IDSP)/7)
  1073. 20845    CLDD$=RIGHT$("  "+STR$(IDSP+1),2)
  1074. 20850    CLDC=7:CLDX=X0+CLX*XP+12:CLDY=Y0+CLY*YP+8
  1075. 20852    IF CLX=0 THEN CLDC=2
  1076. 20854    IF CLX=6 THEN CLDC=5
  1077. 20856    GOSUB *祝日検出
  1078. 20860    SYMBOL(CLDX,CLDY),CLDD$,1,1,CLDC
  1079. 20870  NEXT IDSP
  1080. 20880  INTERVAL ON
  1081. 20885  DEF FONT "システム   12ﾄﾞｯﾄ"
  1082. 20890  RETURN
  1083. 20895 '
  1084. 20900 *マーク追加表示
  1085. 20905  X0=40:Y0=160:XP=56:YP=37:MK$="★"
  1086. 20911  MKYOF=2 :MKCL=12:MKL=40:MKW$=EVENT$
  1087. 20920  IF MKW$=SPACE$(MKL)      THEN MKCL=6
  1088. 20925  IF INSTR(MKW$,"誕生")<>0 THEN MKCL=10
  1089. 20930  CLDX=X0+TBX*XP:CLDY=Y0+TBY*YP
  1090. 20945  SYMBOL(CLDX+30,CLDY+MKYOF),MK$,.5!,.5!,%MKCL
  1091. 20950  RETURN
  1092. 20960 '
  1093. 21100 *カレンダー消去
  1094. 21110  CSRINIT=0
  1095. 21120  PUT@A(22,156)-(421,392),MAT#
  1096. 21130  X0=438:Y0=128:LINE(X0,Y0)-(X0+180,Y0+112),PSET,%0,BF
  1097. 21140  X0=438:Y0=280:LINE(X0,Y0)-(X0+180,Y0+112),PSET,%0,BF
  1098. 21150  LINE(505,101)-(618,117),PSET,%8,BF
  1099. 21160  LINE(505,253)-(618,269),PSET,%8,BF
  1100. 21170  LINE(77,404)-(420,421),PSET,%8,BF
  1101. 21180  RETURN
  1102. 21190 '
  1103. 21200 *日カーソル表示
  1104. 21210  XM0=30:XMP=56:YM0=159:YMP=37
  1105. 21220  DCSR=TBY*7+TBX
  1106. 21230  GOSUB *日カーソル消去
  1107. 21240  XM1=XM0+TBX*XMP:YM1=YM0+TBY*YMP
  1108. 21250  XM2=XM1+48     :YM2=YM1+33
  1109. 21255  LINE(XM1+1,YM1+1)-(XM2+1,YM2+1),PSET,0,B
  1110. 21260  LINE(XM1,YM1)-(XM2,YM2),PSET,%15,B
  1111. 21270  DCSRX=DCSR:TBXX=TBX:TBYX=TBY
  1112. 21280  RETURN
  1113. 21290 '
  1114. 21300 *日カーソル消去
  1115. 21310  IF CSRINIT=0 THEN CSRINIT=1:GOTO 21350
  1116. 21320  XM1=XM0+TBXX*XMP:YM1=YM0+TBYX*YMP
  1117. 21330  XM2=XM1+48      :YM2=YM1+33
  1118. 21335  LINE(XM1+1,YM1+1)-(XM2+1,YM2+1),PSET,%6,B
  1119. 21340  LINE(XM1,YM1)-(XM2,YM2),PSET,%6,B
  1120. 21350  RETURN
  1121. 21360 '
  1122. 21400 *行事表示
  1123. 21410  EVENT$=EVDT$(MN,SELDY)
  1124. 21420  LINE(77,404)-(420,421),PSET,%8,BF
  1125. 21430  SYMBOL(80,407),EVENT$,.75!,.75!,7
  1126. 21440  RETURN
  1127. 21450 '
  1128. 21500 *行事入力
  1129. 21510  LX=80:LY=407:LL=40:LG=1:LP=1:LC=6:CBC=8:LINS=1
  1130. 21520 ' LOCATE LX,LY:COLOR LC:PRINT LM$
  1131. 21530  L$(1)=EVENT$:GOSUB *LKEYIN
  1132. 21540  EVENT$=LMG$
  1133. 21550  SYMBOL(LX,LY),EVENT$,.75!,.75!,7
  1134. 21560  RETURN
  1135. 21570 '
  1136. 22000 *祝日検出
  1137. 22005  HOLDY=0:EVEX=0
  1138. 22010  CLEV$=EVDT$(MN,IDSP+1)
  1139. 22020  IF 休日1$="" THEN 22032
  1140. 22025  IF CLEV$<>SPACE$(40) THEN EVEX=1
  1141. 22030  IF INSTR(CLEV$,休日1$)<>0 THEN CLDC=2:HOLDY=(1 AND 代休1)
  1142. 22032  IF 休日2$="" THEN 22040
  1143. 22036  IF INSTR(CLEV$,休日2$)<>0 THEN CLDC=2:HOLDY=(1 AND 代休2)
  1144. 22040  IF CLX=1 AND HOLDYX=1 THEN CLDC=2
  1145. 22070  HOLDYX=HOLDY
  1146. 22080  RETURN
  1147. 22090 '
  1148. 22100 *年間カレンダー用紙
  1149. 22110  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  1150. 22115  MOUSE 1,,,0
  1151. 22120  LOAD@ TIFDRV$+"\HK2year.tif",(W_X1(G),W_Y1(G))
  1152. 22122  SYMBOL(W_X1(G)+120,W_Y1(G)+4),YR$+"年",.75!,.75!,0,,,&H01
  1153. 22125  MOUSE 1,,,1
  1154. 22150  RETURN
  1155. 22160 '
  1156. 22200 *年間カレンダー表示
  1157. 22205  X0=W_X1(G)+34:XP=10:Y0=W_Y1(G)+38:YP=16
  1158. 22210  YRMX=YR:MNMX=MN:DYMX=DY:YRX$=YR$:MNX$=MN$:DYX$=DY$
  1159. 22215  DY=1:MCN=2:GOSUB *MCDSET
  1160. 22220  FOR MN=1 TO 12:GOSUB *WEEKN
  1161. 22230    FOR IDSP=0 TO MNDN-1
  1162. 22240      CLX=(WK+IDSP) MOD 7
  1163. 22260      CLDD$=RIGHT$("  "+STR$(IDSP+1),2)
  1164. 22270      CLDC=0:CLDX=X0+(WK+IDSP)*XP:CLDY=Y0+YP*(MN-1)
  1165. 22280      IF CLX=0 THEN CLDC=2
  1166. 22290      IF CLX=6 THEN CLDC=1
  1167. 22300      GOSUB *祝日検出
  1168. 22310      SYMBOL(CLDX,CLDY),CLDD$,.5!,.6!,CLDC
  1169. 22320    NEXT IDSP
  1170. 22330  NEXT MN
  1171. 22335  MCN=1:GOSUB *MCDSET
  1172. 22340  YR=YRMX:MN=MNMX:DY=DYMX:YR$=YRX$:MN$=MNX$:DY$=DYX$
  1173. 22350  RETURN
  1174. 22360 '
  1175. 22400 *年月日表示S
  1176. 22405  IF G=8 THEN XF=83:YF=221:GOTO 22410
  1177. 22406  XF=70
  1178. 22407  IF INO=1 THEN YF=28 ELSE YF=56
  1179. 22410  X0=W_X1(G)+XF:Y0=W_Y1(G)+YF
  1180. 22420  LINE(X0+  0,Y0)-(X0+ 40,Y0+13),PSET,0,BF
  1181. 22422  LINE(X0+ 70,Y0)-(X0+ 96,Y0+13),PSET,0,BF
  1182. 22424  LINE(X0+112,Y0)-(X0+138,Y0+13),PSET,0,BF
  1183. 22430  SYMBOL(X0+  2,Y0+2),RIGHT$(STR$(10000+YRI(INO)),4)+"年",.75!,.75!,4
  1184. 22432  SYMBOL(X0+ 72,Y0+2),RIGHT$(STR$(100+MNI(INO)),2)  +"月",.75!,.75!,4
  1185. 22434  SYMBOL(X0+114,Y0+2),RIGHT$(STR$(100+DYI(INO)),2)  +"日",.75!,.75!,4
  1186. 22480  RETURN
  1187. 22490 '
  1188. 22500 *日数計算用紙
  1189. 22510  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  1190. 22515  MOUSE 1,,,0
  1191. 22520  LOAD@ TIFDRV$+"\HK2dcnt.tif",(W_X1(G),W_Y1(G))
  1192. 22525  MOUSE 1,,,1
  1193. 22540  RETURN
  1194. 22550 '
  1195. 22600 *日数計算メイン
  1196. 22620  YRMX=YR:MNMX=MN:DYMX=DY:YRX$=YR$:MNX$=MN$:DYX$=DY$
  1197. 22630  YRI(1)=TY:MNI(1)=TM:DYI(1)=TD
  1198. 22632  IF SELCF=1 THEN YRI(2)=YR:MNI(2)=MN:DYI(2)=SELDY:GOTO 22640
  1199. 22634                  YRI(2)=TY:MNI(2)=TM:DYI(2)=TD
  1200. 22640  INO=1:GOSUB *年月日表示S
  1201. 22644  INO=2:GOSUB *年月日表示S
  1202. 22650 *YMDSEL
  1203. 22655  SWPASS=0:G=7:GOSUB *MCSELECT
  1204. 22660  IF SWNO<0 THEN SWNO=2
  1205. 22670  IF SWNO>3 THEN GOSUB *YMDCHG:GOTO *YMDSEL
  1206. 22680  IF SWNO=3 THEN GOSUB *MCDRAG:GOTO *YMDSEL
  1207. 22700  ON SWNO GOTO *SN01,*SN02
  1208. 22710 *SN01:'実行
  1209. 22720  B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  1210. 22730  GOSUB *日数計算
  1211. 22740  B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  1212. 22750  GOTO *YMDSEL
  1213. 22760 *SN02:'取消
  1214. 22770  B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  1215. 22780  YR=YRMX:MN=MNMX:DY=DYMX:YR$=YRX$:MN$=MNX$:DY$=DYX$
  1216. 22790  RETURN
  1217. 22840 '
  1218. 22900 *YMDCHG
  1219. 22910  B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  1220. 22920  BTCD=SWNO-3:INO=1
  1221. 22930  IF G=8 THEN 22940
  1222. 22935  IF BTCD>10 THEN INO=2:BTCD=BTCD-10
  1223. 22940  ON BTCD GOTO *Y01,*Y02,*Y03,*Y04,*Y05,*Y06,*Y07,*Y08,*Y09,*Y10
  1224. 22960  *Y01:YDEF=+1 :MDEF=0 :DDEF=0  :GOTO *Y50
  1225. 22961  *Y02:YDEF=-1 :MDEF=0 :DDEF=0  :GOTO *Y50
  1226. 22962  *Y03:YDEF=+10:MDEF=0 :DDEF=0  :GOTO *Y50
  1227. 22963  *Y04:YDEF=-10:MDEF=0 :DDEF=0  :GOTO *Y50
  1228. 22964  *Y05:YDEF=0  :MDEF=+1:DDEF=0  :GOTO *Y50
  1229. 22965  *Y06:YDEF=0  :MDEF=-1:DDEF=0  :GOTO *Y50
  1230. 22966  *Y07:YDEF=0  :MDEF=0 :DDEF=+1 :GOTO *Y50
  1231. 22967  *Y08:YDEF=0  :MDEF=0 :DDEF=-1 :GOTO *Y50
  1232. 22968  *Y09:YDEF=0  :MDEF=0 :DDEF=+10:GOTO *Y50
  1233. 22969  *Y10:YDEF=0  :MDEF=0 :DDEF=-10:GOTO *Y50
  1234. 22980 *Y50
  1235. 22990  YR=YRI(INO):MN=MNI(INO):DY=DYI(INO)
  1236. 23000  GOSUB *年月日変更
  1237. 23010  YRI(INO)=YR:MNI(INO)=MN:DYI(INO)=DY
  1238. 23020  GOSUB *年月日表示S
  1239. 23030  B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  1240. 23040  RETURN
  1241. 23090 '
  1242. 23200 *誕生日入力
  1243. 23210  YR=YRI(1):MN=MNI(1):DY=DYI(1)
  1244. 23240  GOSUB *WEEKN:BIRTH#=YDN#
  1245. 23250  GOSUB *BTPUT
  1246. 23280  YR=YRMX:MN=MNMX:DY=1
  1247. 23290  GOSUB *WEEKN:MNB#=YDN#
  1248. 23300  RETURN
  1249. 23310 '
  1250. 23350 *バイオリズム用紙
  1251. 23360  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  1252. 23362  MOUSE 1,,,0
  1253. 23365  LOAD@ TIFDRV$+"\hk2BIO.TIF",(W_X1(G),W_Y1(G))
  1254. 23367  MOUSE 1,,,1
  1255. 23368  GET@A(W_X1(G)+36,W_Y1(G)+30)-(W_X1(G)+408,W_Y1(G)+213),BIOD#
  1256. 23370  SYMBOL(W_X1(G)+105,W_Y1(G)+4),YR$+"年 "+MN$+"月",.75!,.75!,0,,,&H01
  1257. 23380  RETURN
  1258. 23390 '
  1259. 23400 *バイオリズム表示
  1260. 23410  TTLD#=MNB#-BIRTH#  '  生まれてから今日までの日数 
  1261. 23415  PUT@A(W_X1(G)+36,W_Y1(G)+30)-(W_X1(G)+408,W_Y1(G)+213),BIOD#
  1262. 23420  '身体            感情           知性
  1263. 23430  J=TTLD# MOD 23:K=TTLD# MOD 28:L=TTLD# MOD 33
  1264. 23440  '  ----------------  グラフ表示
  1265. 23450  JI=(J-2)*360/23:KI=(K-2)*360/28:LI=(L-2)*360/33
  1266. 23460  FOR N%=0 TO 528 STEP 4
  1267. 23470    X=W_X1(G)+40+N%*.68!
  1268. 23480    W=W_Y1(G)+131-SIN(.01745!*JI+.01745!*N%*.97826!)*80
  1269. 23490    IF N%<>0 THEN LINE(X,W)-(XX,WX),PSET,1
  1270. 23500    Y=W_Y1(G)+131-SIN(.01745!*KI+.01745!*N%*.80357!)*80
  1271. 23510    IF N%<>0 THEN LINE(X,Y)-(XX,YX),PSET,2
  1272. 23520    Z=W_Y1(G)+131-SIN(.01745!*LI+.01745!*N%*.68182!)*80
  1273. 23530    IF N%<>0 THEN LINE(X,Z)-(XX,ZX),PSET,4
  1274. 23535    XX=X:WX=W:YX=Y:ZX=Z
  1275. 23540  NEXT
  1276. 23545  IF SELCF=0 THEN 23580
  1277. 23550  X=W_X1(G)+40+(SELDY-1)*12:Y=W_Y1(G)
  1278. 23560  LINE(X,Y+46)-(X,Y+211),PSET,6
  1279. 23565  LINE(X-5,Y+35)-(X+5,Y+45),XOR,6,BF
  1280. 23580  RETURN
  1281. 23590 '
  1282. 23600 *メモ一覧用紙
  1283. 23610  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  1284. 23612  MOUSE 1,,,0
  1285. 23615  LOAD@ TIFDRV$+"\hk2event.TIF",(W_X1(G),W_Y1(G))
  1286. 23618  MOUSE 1,,,1
  1287. 23620  SYMBOL(W_X1(G)+80,W_Y1(G)+4),YR$+"年 "+MN$+"月",.75!,.75!,0,,,&H01
  1288. 23630  RETURN
  1289. 23640 '
  1290. 23650 *用紙消去
  1291. 23660  PUT@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  1292. 23670  RETURN
  1293. 23680 '
  1294. 23700 *バイオリズムメイン
  1295. 23705  YRMX=YR:MNMX=MN:DYMX=DY:YRX$=YR$:MNX$=MN$:DYX$=DY$
  1296. 23710  GOSUB *BTCHK
  1297. 23715  IF BTCHK=0 THEN YRI(1)=1958:MNI(1)=2:DYI(1)=4
  1298. 23720  INO=1:GOSUB *年月日表示S
  1299. 23730 *BIOSEL
  1300. 23732  SWPASS=0:G=8:GOSUB *MCSELECT
  1301. 23734  IF SWNO<0 THEN SWNO=2
  1302. 23736  IF SWNO>3 THEN GOSUB *YMDCHG:GOTO *BIOSEL
  1303. 23738  IF SWNO=3 THEN GOSUB *MCDRAG:GOTO *BIOSEL
  1304. 23740  ON SWNO GOTO *BI01,*BI02
  1305. 23750 *BI01:'実行
  1306. 23752  B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  1307. 23754  GOSUB *誕生日入力
  1308. 23755  GOSUB *バイオリズム表示
  1309. 23756  B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  1310. 23758  GOTO *BIOSEL
  1311. 23770 *BI02:'取消
  1312. 23772  B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  1313. 23774  YR=YRMX:MN=MNMX:DY=DYMX:YR$=YRX$:MN$=MNX$:DY$=DYX$
  1314. 23776  RETURN
  1315. 23790 '
  1316. 23800 *行事一覧表示メイン
  1317. 23810  MESN=16:GOSUB *MESDSP
  1318. 23820  MDAR=1:DYMX=DY
  1319. 23825  B=MDAR:BST(G,B)=1:BSNDOFF=1:GOSUB *BTN_ONOFF 
  1320. 23835  GOSUB *行事一覧表示
  1321. 23840  G=4:GOSUB *MCSELECT
  1322. 23842  IF SWNO<0 THEN SWNO=4
  1323. 23843  IF SWNO=5 THEN GOSUB *MCDRAG:GOTO 23840
  1324. 23850  ON SWNO GOTO *SE1,*SE1,*SE1,*SE2
  1325. 23860  *SE1:IF SWNO=MDAR THEN 23840
  1326. 23862       B=MDAR:BST(G,B)=0:GOSUB *BTN_ONOFF 
  1327. 23864       MDAR=SWNO
  1328. 23866       B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF 
  1329. 23868       GOTO 23835
  1330. 23870  *SE2:DY=DYMX
  1331. 23875       B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF 
  1332. 23880       RETURN
  1333. 23890 '
  1334. 24000 *日数計算
  1335. 24020  X1=W_X1(G)+71 :Y1=W_Y1(G)+83
  1336. 24025  X2=W_X1(G)+234:Y2=W_Y1(G)+110
  1337. 24050  LINE(X1,Y1)-(X2,Y2),PSET,%8,BF
  1338. 24090  YR=YRI(1):MN=MNI(1):DY=DYI(1)
  1339. 24100  GOSUB *WEEKN:SDAT#=YDN#
  1340. 24120  YR=YRI(2):MN=MNI(2):DY=DYI(2)
  1341. 24140  GOSUB *WEEKN:EDAT#=YDN#
  1342. 24150  DNN#=ABS(EDAT#-SDAT#)
  1343. 24160  SYMBOL(X1+2,Y1),"開始日～終了日:"+STR$(DNN#)+"日",.75!,.75!,7
  1344. 24170  DNNH#=DNN#*24
  1345. 24180  SYMBOL(X1+2,Y1+15),"時間換算:"+STR$(DNNH#)+"時間",.75!,.75!,7
  1346. 24200  RETURN
  1347. 24210 '
  1348. 24220 *日数計算消去
  1349. 24240  LOCATE 10,21:PRINT SPACE$(40)
  1350. 24245  LOCATE 10,21:COLOR 7:PRINT EVENT$
  1351. 24270  RETURN
  1352. 24280 '
  1353. 24400 *行事一覧表示
  1354. 24405  X0=W_X1(G)+11:Y0=W_Y1(G)+28:YP=17
  1355. 24410  FOR II=0 TO 10:Y=Y0+II*YP
  1356. 24411    LINE(X0,Y)-(X0+53, Y+11),PSET,%5,BF
  1357. 24412    LINE(X0+64,Y)-(X0+314,Y+11),PSET,%6,BF
  1358. 24413  NEXT II
  1359. 24415  IF MDAR=3 THEN MDL=11 ELSE MDL=10
  1360. 24420  SD=(MDAR-1)*10+1:ED=SD+MDL-1:MDL=0
  1361. 24430  FOR DY=SD TO ED:CL=0
  1362. 24440    GOSUB *週検索:IF CW=5 THEN CW=1
  1363. 24445    IF EVDT$(MN,DY)<>SPACE$(40) THEN EVDSP$=EVDT$(MN,DY):GOTO 24450
  1364. 24446    EVDSP$="":CL=1
  1365. 24450    DEF FONT "システム   12ﾄﾞｯﾄ"
  1366. 24452    SYMBOL(X0   ,Y0+ MDL *YP),RIGHT$("  "+STR$(DY),2)+"日",.75!,.75!,0
  1367. 24453    SYMBOL(X0+30,Y0+ MDL *YP),WKM$,.75!,.75!,CW
  1368. 24454    SYMBOL(X0+64,Y0+ MDL *YP),EVDSP$,.75!,.75!,CL
  1369. 24458    MDL=MDL+1
  1370. 24459    IF DY=MNDN THEN DY=ED+1
  1371. 24460  NEXT DY
  1372. 24470  RETURN
  1373. 24480  '
  1374. 25000 *ガイド表示
  1375. 25010  LINE(302,30)-(414,46),PSET,0,BF
  1376. 25015  LX=304:LY=32
  1377. 25020  IF GMCD=0 THEN RETURN
  1378. 25030  ON GMCD GOTO *GM1,*GM2,*GM3,*GM4,*GM5
  1379. 25040  '
  1380. 25050  *GM1:SYMBOL(LX,LY),"年間カレンダ－表示",.75!,.75!,4:RETURN
  1381. 25060  *GM2:SYMBOL(LX,LY),"   行事一覧表示   ",.75!,.75!,4:RETURN
  1382. 25070  *GM3:SYMBOL(LX,LY),"   日 数 計 算    ",.75!,.75!,4:RETURN
  1383. 25080  *GM4:SYMBOL(LX,LY),"   バイオリズム   ",.75!,.75!,4:RETURN
  1384. 25090  *GM5:SYMBOL(LX,LY),"指定日の家計簿記入",.75!,.75!,4:RETURN
  1385. 30480 '
  1386. 30500 *数字漢字変換
  1387. 30505  NBK$=""
  1388. 30510  FOR INBK=1 TO NBN
  1389. 30512    NBAX$=MID$(NBA$,INBK,1)
  1390. 30514    IF NBAX$=" " THEN NBK$=NBK$+"　":GOTO 30530
  1391. 30520    NBK$=NBK$+KNJ$(&H2330+VAL(NBAX$))
  1392. 30530  NEXT INBK
  1393. 30540  RETURN
  1394. 30580 '
  1395. 30820 *カレンダー選択判定
  1396. 30830  XM0=30:XMP=56:YM0=159:YMP=37:TBMSEL=0
  1397. 30840  TBX=INT((X_M-XM0-1)/XMP):TBY=INT((Y_M-YM0-1)/YMP)
  1398. 30850    IF TBX<0 OR TBX>6 THEN 30885 
  1399. 30860    IF TBY<0 OR TBY>5 THEN 30885 
  1400. 30865    IF CLM(TBX,TBY)=0 THEN 30885 
  1401. 30870    TBMSEL=1:PLAY "o5l16ec"
  1402. 30875    WAIT SWAIT/5
  1403. 30880  RETURN
  1404. 30885  MCN=3:GOSUB *MCDSET:PLAY "o6v8l16ce"
  1405. 30886  WAIT SWAIT:MCN=1:GOSUB *MCDSET:RETURN
  1406. 30890 '
  1407. 31000 *FADEOUT:CLS 1:CONSOLE 0,24,0
  1408. 31010  FOR II=0 TO 15
  1409. 31020    PALETTE II,[16*II,16*II,16*II]
  1410. 31030  NEXT II
  1411. 31040  FOR II=0 TO 255 STEP 5
  1412. 31050    FOR JJ=0 TO 15:KK=16*JJ+II*(255-16*JJ)/255
  1413. 31054      PALETTE JJ,[KK,KK,KK]
  1414. 31056    NEXT JJ
  1415. 31060  NEXT II
  1416. 31070  RETURN
  1417. 31080 '
  1418. 31200 *確認
  1419. 31205  G=3:SWNOX=SWNO:MOUSE 1,,,0
  1420. 31210  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  1421. 31220  LOAD@ TIFDRV$+"\CAUTION2.TIF",(W_X1(G),W_Y1(G))
  1422. 31225  PLAY "o6l4ce":MOUSE 1,,,1
  1423. 31230  FOR II=1 TO 4
  1424. 31232    SYMBOL(W_X1(G)+102,W_Y1(G)+9),CMES$,.75!,.75!,6
  1425. 31234    WAIT SWAIT\10+1
  1426. 31236    LINE(W_X1(G)+102,W_Y1(G)+9)-(W_X1(G)+102+6*39,W_Y1(G)+9+12),PSET,%9,BF
  1427. 31237    WAIT SWAIT\10+1
  1428. 31238  NEXT II
  1429. 31239  SYMBOL(W_X1(G)+102,W_Y1(G)+9),CMES$,.75!,.75!,7
  1430. 31240  MESN=19:GOSUB *SNDMSG:'28chr
  1431. 31241  G=3:GOSUB *MCSELECT'ボタン選択
  1432. 31242  IF SWNO<0 THEN SWNO=2
  1433. 31243  IF SWNO=3 THEN GOSUB *MCDRAG:GOTO 31241
  1434. 31244  IF SWNO=0 THEN 31241
  1435. 31245  G=3:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  1436. 31260  WAIT SWAIT\5+1
  1437. 31270  PUT@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  1438. 31272  CAUNO=SWNO:SWNO=SWNOX
  1439. 31275  RETURN
  1440. 31280 '
  1441. 32000 '
  1442. 32010 *ABOUT表示
  1443. 32020  X1A=146:Y1A=150:XPA=326:YPA=100
  1444. 32030  MOUSE 1,,,0
  1445. 32040  GET@A(X1A,Y1A)-(X1A+XPA,Y1A+YPA),ABOUTD#
  1446. 32050  LOAD@ TIFDRV$+"\hk2logo.tif",(X1A,Y1A)
  1447. 32060  MOUSE 1,,,1
  1448. 32070  CMES$=ABOUT$:GOSUB *確認
  1449. 32080  PUT@A(X1A,Y1A)-(X1A+XPA,Y1A+YPA),ABOUTD#
  1450. 32090  RETURN
  1451. 32100 '
  1452. 34000 *PATHMAKE:'---------- パス作成 -------------------------------
  1453. 34005  DRV$=LEFT$(XDRV$,2)
  1454. 34010  IF LEN(XDRV$)=3 THEN DRV$=LEFT$(XDRV$,2):PATH$="":GOTO 34020
  1455. 34015  PATH$=RIGHT$(XDRV$,LEN(XDRV$)-2)
  1456. 34020  RETURN
  1457. 34030 '
  1458. 35000 *EVOPN:'行事データファイルオープン
  1459. 35005  XDRV$=PRGDRV$:GOSUB *PATHMAKE
  1460. 35020  FLN$=DRV$+"(40)"+PATH$+"\EVENT.DAT"
  1461. 35030  OPEN "R",#1,FLN$
  1462. 35040  FIELD #1,40 AS EV$
  1463. 35060  RETURN
  1464. 35070 '
  1465. 35400 *DTSAVE:'---------- 日付ジャンプデータファイル作成
  1466. 35402  GOSUB *DTCHK
  1467. 35405  XDRV$=RAMDRV$:GOSUB *PATHMAKE
  1468. 35420  FLN$=DRV$+PATH$+"\SRCjump.DAT"
  1469. 35430  OPEN "O",#1,FLN$
  1470. 35440  PRINT #1,DT$:CLOSE
  1471. 35450  RETURN
  1472. 35460 '
  1473. 35500 *DTCHK :'---------- 日付ジャンプデータファイルチェック
  1474. 35505  XDRV$=RAMDRV$:GOSUB *PATHMAKE
  1475. 35520  FLN$=DRV$+"(1)"+PATH$+"\SRCjump.DAT"
  1476. 35530  OPEN "R",#1,FLN$:FIELD #1,1 AS X$
  1477. 35540  CLOSE :KILL DRV$+PATH$+"\SRCjump.DAT"
  1478. 35550  RETURN
  1479. 35560 '
  1480. 36000 *EVGET:'行事データファイル読み込み
  1481. 36010  GOSUB *EVOPN:R=1
  1482. 36020  FOR II=1 TO 12:FOR JJ=1 TO 32
  1483. 36030    GET #1,R
  1484. 36040    EVDT$(II,JJ)=EV$
  1485. 36050    R=R+1
  1486. 36060  NEXT JJ:NEXT II
  1487. 36070  CLOSE
  1488. 36080  RETURN
  1489. 36090 '
  1490. 36100 *EVPUT:'行事データファイル書き込み
  1491. 36110  GOSUB *EVOPN:R=1
  1492. 36120  R=(MN-1)*32+SELDY
  1493. 36130  LSET EV$=EVENT$
  1494. 36140  PUT #1,R
  1495. 36170  CLOSE
  1496. 36180  RETURN
  1497. 36190 '
  1498. 36700 *BTOPN:'誕生日データファイルオープン
  1499. 36705  XDRV$=PRGDRV$:GOSUB *PATHMAKE
  1500. 36720  FLN$=DRV$+"(8)"+PATH$+"\BIRTH.DAT"
  1501. 36730  OPEN "R",#3,FLN$
  1502. 36740  FIELD #3,4 AS BYR$,2 AS BMN$,2 AS BDY$
  1503. 36760  RETURN
  1504. 36770 '
  1505. 36800 *BTCHK
  1506. 36810  GOSUB *BTOPN
  1507. 36820  IF LOF(3)=0 THEN BTCHK=0:GOTO 36850
  1508. 36830  BTCHK=1
  1509. 36840  GET #3,1
  1510. 36845  YRI(1)=VAL(BYR$)
  1511. 36846  MNI(1)=VAL(BMN$)
  1512. 36847  DYI(1)=VAL(BDY$)
  1513. 36850  CLOSE
  1514. 36860  RETURN
  1515. 36870 '
  1516. 36900 *BTPUT
  1517. 36910  GOSUB *BTOPN
  1518. 36920  LSET BYR$=RIGHT$(STR$(YRI(1)+10000),4)
  1519. 36922  LSET BMN$=RIGHT$(STR$(MNI(1)+100),2)
  1520. 36924  LSET BDY$=RIGHT$(STR$(DYI(1)+100),2)
  1521. 36930  PUT #3,1
  1522. 36940  CLOSE
  1523. 36950  RETURN
  1524. 36960 '
  1525. 39000 '//////////////////////////////////////////////////
  1526. 39010 *CONFIGファイルチェック'  V1.4 1994.06.19
  1527. 39020 '                         FOR HK T.Komura
  1528. 39030  CFLNO=0
  1529. 39040  OPEN "R",#1,"(1)HK.CFG"
  1530. 39050  FIELD #1,1 AS D$
  1531. 39060  IF LOF(1)=0 THEN *CFGFE1
  1532. 39070  CLOSE
  1533. 39080  OPEN "I",#1,"HK.CFG"
  1534. 39085  GOSUB *CFGREAD:ABOUT$=CFG$ :'-- about$         [0]
  1535. 39090  GOSUB *CFGREAD:PRGDRV$=CFG$:'-- PRGDRV$        [1]
  1536. 39092  FILES ,C,ARY&:N=ARY&(1):DIM ARY$(N)
  1537. 39094  FILES ,N,ARY$:PRGDRV$=ARY$(0):ERASE ARY$
  1538. 39100  GOSUB *CFGREAD:DATDRV$=CFG$:'-- DATDRV$        [2]
  1539. 39110  GOSUB *CFGREAD:RAMDRV$=CFG$:'-- RAMDRV$        [3]
  1540. 39120  TIFDRV$=PRGDRV$+"\TIFF"    :'-- TIFDRV$        [4]
  1541. 39130  GOSUB *CFGREAD:FMBDRV$=CFG$:'-- FMBDRV$        [5]
  1542. 39140  GOSUB *CFGREAD             :'-- SNDMF          [6]
  1543. 39150    IF LEFT$(CFG$,5)<>"SNDMF" THEN *CFGFE2
  1544. 39160    SNDMF=VAL(RIGHT$(CFG$,1))
  1545. 39170  GOSUB *CFGREAD:SNDDRV$=CFG$:'-- SNDDRV$        [7]
  1546. 39180  GOSUB *CFGREAD             :'-- SWAIT          [8]
  1547. 39190    IF LEFT$(CFG$,4)<>"WAIT" THEN *CFGFE2
  1548. 39200    SWAIT=VAL(RIGHT$(CFG$,LEN(CFG$)-5))
  1549. 39210  FOR II=1 TO 15             :'             [9]-[10]
  1550. 39220    GOSUB *CFGREAD:CFI$(II)=CFG$
  1551. 39230  NEXT II
  1552. 39240  GOSUB *CFGREAD             :'-- DICIF         [11]
  1553. 39250    IF LEFT$(CFG$,5)<>"DICIF" THEN *CFGFE2
  1554. 39260    DICIF=VAL(RIGHT$(CFG$,1))
  1555. 39270  GOSUB *CFGREAD             :'-- DICSF         [11]
  1556. 39280    IF LEFT$(CFG$,5)<>"DICSF" THEN *CFGFE2
  1557. 39290    DICSF=VAL(RIGHT$(CFG$,1))
  1558. 39300  GOSUB *CFGREAD:DICDRV$=CFG$:'-- DICDRV$       [12]
  1559. 39310  GOSUB *CFGREAD             :'-- taxr$         [13]
  1560. 39320    IF LEFT$(CFG$,4)<>"TAXR" THEN *CFGFE2
  1561. 39330    TAXR$=RIGHT$(CFG$,LEN(CFG$)-5)
  1562. 39340  GOSUB *CFGREAD             :'-- CALCF         [14]
  1563. 39350    IF LEFT$(CFG$,5)<>"CALCF" THEN *CFGFE2
  1564. 39360    CALCF=VAL(RIGHT$(CFG$,1))
  1565. 39370  GOSUB *CFGREAD             :'--SDAY           [15]
  1566. 39380    IF LEFT$(CFG$,4)<>"SDAY" THEN *CFGFE2
  1567. 39390    SDAY=VAL(RIGHT$(CFG$,2))
  1568. 39400    SDAY$=RIGHT$(STR$(100+SDAY),2)
  1569. 39410    IF SDAY>0 THEN MOFF=0 ELSE MOFF=-1
  1570. 39420  GOSUB *CFGREAD             :'-- SSYMD$        [16]
  1571. 39430    IF LEFT$(CFG$,5)<>"SSYMD" THEN *CFGFE2
  1572. 39440    SSYMD$=RIGHT$(CFG$,8)
  1573. 39450  CLOSE
  1574. 39460  RETURN
  1575. 39470 *CFGREAD:'////////////////////////////////////
  1576. 39480  IF EOF(1)<>0 THEN *CFGFE3
  1577. 39490  LINE INPUT #1,CFG$:CFLNO=CFLNO+1
  1578. 39500  IF LEFT$(CFG$,1)="/" THEN 39480
  1579. 39510  RETURN
  1580. 39520 '------------------------------------------------------------------
  1581. 39530 *CFGFE1
  1582. 39540  CFE$="HK.CFG ファイルが見当たりません｡ 家計簿を終了します｡"
  1583. 39550  GOTO *CFGFEP
  1584. 39560 *CFGFE2
  1585. 39570  CFE$="HK.CFGファイル 行番号"+STR$(CFLNO)+"の内容に誤りがあります｡ 家計簿を終了します｡"
  1586. 39580  GOTO *CFGFEP
  1587. 39590 *CFGFE3
  1588. 39600  CFE$="HK.CFG ファイルの項目に不足があります｡ 家計簿を終了します｡"
  1589. 39610  GOTO *CFGFEP
  1590. 39620 '-------------------------------------------------------------------
  1591. 39630 *CFGFEP
  1592. 39640  LOCATE 2,23:COLOR 6:PRINT CFE$;
  1593. 39650  CLOSE :WAIT 100
  1594. 39660  STOP
  1595. 39670 '///////////////////////////////////////////////////////////////////
  1596. 40000 *ボタン座標:'-------------------------------------------------------
  1597. 40010 DATA 8   'SWGN        スイッチグループ数 
  1598. 40020 '/////////////////////////////
  1599. 40030 '-------------------- [G1] メインスイッチグループ
  1600. 40040 '    SWN(G),SMX,SMY,SMW
  1601. 40050 DATA 26               :'ボタン個数
  1602. 40060 '    X1 ,X2 ,Y1 ,Y2
  1603. 40070 DATA 000,639,000,479  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1604. 40080 DATA 000,000,000,000  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1605. 40090 '--------------------
  1606. 40100 '    XB1 XB2 YB1 YB2 
  1607. 40110 DATA   0,123,  0, 22  '  HK2   1
  1608. 40120 DATA 124,168,  5, 22  '記  入  2
  1609. 40130 DATA 169,212,  5, 22  '検  索  3
  1610. 40140 DATA 213,256,  5, 22  '分  析  4
  1611. 40150 DATA 257,300,  5, 22  'ｶﾚﾝﾀﾞｰ  5
  1612. 40160 DATA 301,344,  5, 22  '設  定  6
  1613. 40170 DATA 444,567,  0, 22  '日  付  7
  1614. 40180 DATA 568,591,  0, 22  'clock   8
  1615. 40190 DATA 592,615,  0, 22  'help    9
  1616. 40200 DATA 616,639,  0, 22  'END    10
  1617. 40210 '
  1618. 40220 DATA 125,168, 28, 47  'jump   11
  1619. 40230 DATA 213,234, 28, 47  '年間   12
  1620. 40240 DATA 235,256, 28, 47  '行事   13
  1621. 40250 DATA 257,278, 28, 47  '日数   14
  1622. 40260 DATA 279,300, 28, 47  'バイオ 15
  1623. 40270 DATA 544,591, 28, 54  '実行   16
  1624. 40280 DATA 592,639, 28, 54  '取消   17
  1625. 40290 '
  1626. 40300 DATA 117,134, 95,108  '年up   18
  1627. 40310 DATA 117,134,109,122  '年dn   19
  1628. 40320 DATA 135,168, 95,108  '年up10 20
  1629. 40330 DATA 135,168,109,122  '年dn10 21
  1630. 40340 '
  1631. 40350 DATA 257,290, 95,108  '月up   22
  1632. 40360 DATA 257,290,109,122  '月dn   23
  1633. 40370 DATA 438,503,101,117  '前月   24
  1634. 40380 DATA 438,503,253,269  '次月   25
  1635. 40390 DATA  22, 75,404,422  '行事   26
  1636. 40400 '
  1637. 41000 '-------------------- [G2] 年間カレンダースイッチグループ
  1638. 41010 '    SWN(G),SMX,SMY,SMW
  1639. 41020 DATA 2               :'ボタン個数
  1640. 41030 '    X1 ,X2 ,Y1 ,Y2
  1641. 41040 DATA 100,513,150,382  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1642. 41050 DATA 000,639,023,460  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1643. 41060 '--------------------
  1644. 41070 '    XB1 XB2 YB1 YB2 
  1645. 41080 DATA 395,413,  0, 18  'cansel------ 1
  1646. 41100 DATA   3, 16,  3, 16  'drag         2
  1647. 41110 '
  1648. 42000 '-------------------- スイッチグループ[3] 確認
  1649. 42010 DATA 3                :'ボタン個数
  1650. 42020 '    X1 ,X2 ,Y1 ,Y2
  1651. 42030 DATA 106,522,258,287  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1652. 42040 DATA 000,639,023,460  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1653. 42050 '--------------------
  1654. 42060 '    XB1 XB2 YB1 YB2
  1655. 42070 DATA 338,369,  6, 23  ' OK     01
  1656. 42080 DATA 370,401,  6, 23  ' NG     02
  1657. 42090 DATA   8, 27,  5, 24  'drag
  1658. 42100 '
  1659. 42110 '
  1660. 42120 '-------------------- スイッチグループ(4) 行事
  1661. 42130 DATA 5                :'ボタン個数
  1662. 42140 '    X1 ,X2 ,Y1 ,Y2
  1663. 42150 DATA 150,485,150,371  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1664. 42160 DATA   0,639,023,460  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1665. 42170 '    XB1 XB2 YB1 YB2 SWM$         SMC
  1666. 42180 DATA 209,244,  0, 18  ' 上旬
  1667. 42190 DATA 245,280,  0, 18  ' 中旬
  1668. 42200 DATA 281,316,  0, 18  ' 下旬
  1669. 42210 DATA 317,335,  0, 18  ' exit
  1670. 42220 DATA   3, 16,  3, 16  ' drag
  1671. 42290 '
  1672. 42400 '-------------------- スイッチグループ(5) Helpグループ
  1673. 42410 DATA 6               :'ボタン個数
  1674. 42420 '    X1 ,X2 ,Y1 ,Y2
  1675. 42430 DATA  60,577,100,421  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1676. 42440 DATA 000,639,023,460  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1677. 42450 '
  1678. 42460 '    XB1 XB2 YB1 YB2 SWM$     SMC SWNO.
  1679. 42470 DATA 499,512, 25, 38  '前頁
  1680. 42480 DATA 499,512, 39, 52  '前行
  1681. 42490 DATA 499,512,289,302  '次行
  1682. 42500 DATA 499,512,303,316  '次頁
  1683. 42510 DATA 499,512,  6, 19  '終了
  1684. 42520 DATA   6, 17,  7, 18  'drag
  1685. 42530 '
  1686. 42540 '-------------------- スイッチグループ[6] デジタル時計
  1687. 42550 DATA 2                :'ボタン個数
  1688. 42560 '    X1 ,X2 ,Y1 ,Y2
  1689. 42570 DATA  46,607,100,306  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1690. 42580 DATA 000,639,023,460  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1691. 42590 '--------------------
  1692. 42600 '    XB1 XB2 YB1 YB2 SWM$         SMC
  1693. 42610 DATA 543,561,  0, 18  ' end    01
  1694. 42620 DATA   3, 16,  3, 16  ' drag   02
  1695. 42630 '
  1696. 43030 '-------------------- [G7] 日数計算スイッチグループ
  1697. 43040 '    SWN(G),SMX,SMY,SMW
  1698. 43050 DATA 23               :'ボタン個数
  1699. 43060 '    X1 ,X2 ,Y1 ,Y2
  1700. 43070 DATA 150,393,150,269  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1701. 43080 DATA 000,639,023,460  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1702. 43090 '--------------------
  1703. 43100 '    XB1 XB2 YB1 YB2 
  1704. 43110 DATA 172,207,  0, 18  '実行    1
  1705. 43120 DATA 208,243,  0, 18  '取消    2
  1706. 43130 DATA   3, 16,  3, 16  'drag    3
  1707. 43140 '
  1708. 43150 DATA 111,124, 26, 35  '年up    4
  1709. 43160 DATA 111,124, 36, 45  '年dn    5
  1710. 43170 DATA 125,138, 26, 35  '年+10   6
  1711. 43180 DATA 125,138, 36, 45  '年-10   7
  1712. 43190 DATA 167,180, 26, 35  '月up    8
  1713. 43200 DATA 167,180, 36, 45  '月dn    9
  1714. 43220 DATA 209,222, 26, 35  '日up   10
  1715. 43230 DATA 209,222, 36, 45  '日dn   11
  1716. 43240 DATA 223,236, 26, 35  '日+10  12
  1717. 43245 DATA 223,236, 36, 45  '日-10  13
  1718. 43246 '
  1719. 43250 DATA 111,124, 54, 63  '年up   14
  1720. 43260 DATA 111,124, 64, 73  '年dn   15
  1721. 43270 DATA 125,138, 54, 63  '年+10  16
  1722. 43280 DATA 125,138, 64, 73  '年-10  17
  1723. 43290 DATA 167,180, 54, 63  '月up   18
  1724. 43300 DATA 167,180, 64, 73  '月dn   19
  1725. 43320 DATA 209,222, 54, 63  '日up   20
  1726. 43330 DATA 209,222, 64, 73  '日dn   21
  1727. 43340 DATA 223,236, 54, 63  '日+10  22
  1728. 43345 DATA 223,236, 64, 73  '日-10  23
  1729. 43346 '
  1730. 43530 '-------------------- [G8] バイオリズムスイッチグループ
  1731. 43540 '    SWN(G),SMX,SMY,SMW
  1732. 43550 DATA 13               :'ボタン個数
  1733. 43560 '    X1 ,X2 ,Y1 ,Y2
  1734. 43570 DATA 100,513,150,395  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1735. 43580 DATA 000,639,023,460  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1736. 43590 '--------------------
  1737. 43600 '    XB1 XB2 YB1 YB2 
  1738. 43610 DATA 342,377,  0, 18  '実行    1
  1739. 43620 DATA 378,413,  0, 18  '取消    2
  1740. 43630 DATA   3, 16,  3, 16  'drag    3
  1741. 43640 '
  1742. 43650 DATA 124,137,219,228  '年up    4
  1743. 43660 DATA 124,137,229,238  '年dn    5
  1744. 43670 DATA 138,151,219,228  '年+10   6
  1745. 43680 DATA 138,151,229,238  '年-10   7
  1746. 43690 DATA 180,193,219,228  '月up    8
  1747. 43700 DATA 180,193,229,238  '月dn    9
  1748. 43720 DATA 222,236,219,228  '日up   10
  1749. 43730 DATA 222,236,229,238  '日dn   11
  1750. 43740 DATA 237,249,219,228  '日+10  12
  1751. 43745 DATA 237,249,229,238  '日-10  13
  1752. 43746 '
  1753. 50290 *DCLOCKDATA
  1754. 50300 '    1,2,3,4,5,6,7 
  1755. 50310 DATA 1,1,1,1,1,1,0 '0     (1)
  1756. 50320 DATA 0,1,1,0,0,0,0 '1     ---
  1757. 50330 DATA 1,1,0,1,1,0,1 '2    |   |(2)
  1758. 50340 DATA 1,1,1,1,0,0,1 '3 (6)|(7)|        ●(8)
  1759. 50350 DATA 0,1,1,0,0,1,1 '4     ---
  1760. 50360 DATA 1,0,1,1,0,1,1 '5    |   |(3)     ●(9)
  1761. 50370 DATA 1,0,1,1,1,1,1 '6 (5)|   |
  1762. 50380 DATA 1,1,1,0,0,0,0 '7     ---
  1763. 50390 DATA 1,1,1,1,1,1,1 '8     (4)
  1764. 50400 DATA 1,1,1,1,0,1,1 '9    
  1765. 50410 '    dgx,dgy 
  1766. 50420 DATA  80, 40       '(1)
  1767. 50430 DATA 120, 70       '(2)
  1768. 50440 DATA 110,140       '(3)
  1769. 50450 DATA  80,180       '(4)
  1770. 50460 DATA  40,140       '(5)
  1771. 50470 DATA  50, 70       '(6)
  1772. 50480 DATA  80,100       '(7)
  1773. 50490 DATA 280, 80       '(8)
  1774. 50500 DATA 280,140       '(9)
  1775. 50510 '   ofset
  1776. 50520 DATA 0      '1桁
  1777. 50530 DATA 120    '2桁
  1778. 50540 DATA 280    '3桁
  1779. 50550 DATA 400    '4桁
  1780. 50560 '
  1781. 60000 ' 座標確認 DEBUG ROUTINE
  1782. 60010 'LOAD@ "e:\work\hk2\tiff\hk2bio.tif",(0,0)'
  1783. 60020 MOUSE 0:MOUSE 1,0,0,1
  1784. 60030  IF MOUSE(2,1)<>0 THEN STOP
  1785. 60040  IF MOUSE(2,0)=0 THEN 60040
  1786. 60050  X_M=MOUSE(4,0):Y_M=MOUSE(5,0):LX=INT(X_M/8):LY=INT(Y_M/19)
  1787. 60060  LINE(0,460)-(639,479),PSET,0,BF
  1788. 60070  SYMBOL(0,460),"X="+STR$(X_M)+" Y="+STR$(Y_M),.75!,.75!,6
  1789. 60080  GOTO 60030
  1790. 60090 ' 
  1791. 61000 ' 
  1792. 61010 ' EVENT DUMMY FILE MAKE
  1793. 61020 PRGDRV$="D:\FB386\CALEND"  '
  1794. 61030 GOSUB *EVOPN:R=1
  1795. 61040 FOR I=1 TO 12:FOR J=1 TO 32
  1796. 61050   LSET EV$=SPACE$(40)
  1797. 61060   PUT #1,R:R=R+1
  1798. 61070 NEXT:NEXT:CLOSE:STOP
  1799.